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ABSTRACT 


V 

ARM  (Armum'tion  Resupply  Model )  is  an  interactive/batch  representation 
of  Class  V  flow  from  the  corps  support  area  (CSA)  to  the  weapon.  The 
model  receives  a  file  consisting  of  a  record  of  ammunition  usage  by  unit 
by  armiunition  type  from  a  combat  simulation  (presently,  the  simulation 
being  used  is  METRO).  The  ARM  using  a  preloaded  data  base  of  ammunition 
handling  procedures  and  capabiliites  represents  the  flow  of  ammunition  as 
it  would  have  occurred  within  the  battle.  The  unit  status  over  time  is 
indicative  of  the  capability  of  the  system  to  supply  ammunition  to  the 
weapons  and  the  reasonableness  of  the  firing  doctrine  used  within  the 
attrition  simulation  given  the  anmunition  resupply  system  carrying 
capabilities. 

ARM  is  'written  in  FORTRAN  IV  and  is  machine  independent  with  the 
exception  of  the  subroutine  that  reads  the  file  created  by  the  attrition 
mode  1 . 
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FOREWARD 


In  general,  existing  logistics  models  tend  to  address  resupply 
requirements  in  aggregated  terms,  such  as  tons  per  man  per  day  or  rounds 
per  tube  per  day.  Although  this  approach  has  considerable  merit  for 
evaluating  large  force  structures  engaged  in  sustained  combat,  it  is 
inadequate  for  addressing  the  impact  of  logistics  on  organizations  engaged 
in  short,  intense  conflict  scenarios. 

Ammunition  expenditures  emerging  from  high  level  (as  opposed  to  high 
resolution)  war  games  have  traditionally  been  either  unconstrained  or 
based  on  a  percentage  of  an  "anticipated"  daily  resupply  capability. 
Because  of  this,  support  analyses  have  not  been  the  product  of  a 
concurrent  logistics  simulation  utilizing  the  same  scenario,  but  have  been 
based  on  evaluations  made  after  game  completion.  This  method  can  paint  a 
false  picture  of  a  combat  unit's  effectiveness.  The  logistics  system, 
especially  its  ability  to  resupply  critical  commodities  such  as  arranunition 
and  fuel,  must  be  evaluated  during  the  course  of  the  simulated  battle. 

The  study  directive  for  the  Division-86  study  called  for  a  Force 
Structure  Trade-off  Analysis  (FSTA)  of  various  division  alternatives.  The 
tool  for  this  FSTA  effort  was  the  Jiffy  war  game.  To  derive  meaningful 
insights  into  the  effects  of  the  ammunition  resupply  assets  contained  in 
the  different  force  structures  and  their  impact  on  the  combat 
effectivensss  of  the  various  units  within  the  division,  ammunition 
resupply  had  to  be  evaluated  in  some  detail.  Such  an  evaluation  must 
include  simulating  the  time-consuming  resupply  process  that  places 
ammunition  on  individual  weapon  systems,  as  well  as  the  movement  of  the 
different  units'  transportation  assets  to  secure  additional  ammunition. 

It  is  this  concept  that  provides  the  basis  for  the  Ammunition  Resupply 
Model  (ARM),  a  concept  that  reflects  the  real-world  factors  that  affect 
ammunition  resupply.  ARM  was,  therefore,  developed  to  work  in  parallel 
with  Jiffy  in  conducting  a  total  FSTA  of  the  Division-86  alternatives. 

The  concept  for  ARM  was  developed  in  Oct-Nov  1978,  with  the 
methodology  and  logic  flow  charts  being  completed  in  Dec  1978.  The  actual 
coding  of  the  model  was  accomplished  from  Dec  1978  through  Feb  1979,  and 
the  model  was  operational  in  May  1979.  This  report  provides  the 
documentation  for  the  program  description  and  the  FORTRAN  code  listing. 

The  authors  of  this  report  wish  to  acknowledge  Harry  Jones  of  the 
Model  Design,  Development  and  Validation  Branch  of  COA  for  his  assistance 
in  programming  several  of  the  operating  routines.  Our  thanks  also  to  Mr. 
Ken  Pickett,  Or.  Dave  Bash,  and  Mr.  Harvey  Taylor  of  Methodology  and 
Quality  Assurance  Branch  for  their  help  in  providing  some  initial  file 
structure  organization  and  programming  logic  flow  charts.  Special  thanks 
are  given  to  Mrs.  Elizabeth  Etheridge,  who  served  as  Technical  Editor  for 
this  report,  and  the  girls  In  the  Word  Processing  Center  East,  who  typed 
the  report. 
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PROGRAMMERS  MANUAL 


1.  INTRODUCTION 

a.  This  manual  is  intended  for  the  programmer  who  has  the  task  of 
maintaining,  transferring,  and/or  modifying  the  Ammunition  Resupply  model 
(ARM).  General  information  is  presented  first,  followed  by  more  detailed 
program  descriptions. 

(1)  Paragraph  2  provides  a  general  overview  of  the  program,  its 
developers,  users,  hardware  requirements,  and  major  program  components. 

(2)  Paragraph  3  lists  the  COMMON  blocks  and  defines  the  variables  in 
each.  Tables  show  the  COMMON  blocks  used  in  each  subroutine  and  the 
cross-indexed  list  of  subroutines  using  each  COMMON  block. 

(3)  Paragraph  4  addresses  the  subroutine  structure  of  the  program. 
Flow  diagrams  indicate  the  principal  subroutine  linkages,  and  tables  show 
the  calls  in  each  subroutine  as  well  as  the  cross-indexed  list  of  the 
calling  routines. 

(4)  The  final  paragraph  provides  detailed  information  on  the 
individual  subroutines. 

b.  Descriptions  of  the  input  and  output,  how  the  ARM  is  run,  and  how 
the  results  are  used  will  be  found  in  volume  I  of  the  ARM  documentation. 

2.  GENERAL  INFORMATION 

a.  Sunmary  of  ARM  Operations.  ARM  is  a  set  of  computer  routines 
designed  to  assist  an  analyst  in  studying  the  ammunition  flow  from  the 
Corps  Support  Area  (CSA)  to  the  individual  weapons.  The  initial 
development  objective  was  to  provide  a  methodology  for  addressing 
ammunition  supply  implications  of  the  Divison  86  alternatives.  A  quick 
overview  of  ARM  is  at  figure  1.  The  main  driver  routine  directs  control 
to  five  major  sections: 

o  Data  Base  Modification 

o  Event  Handling 

o  Report  Production 

o  Event  Processing 

o  Check  Point/Restart  Logic 

b.  Program  Developer.  ARM  was  developed  by  the  Combat  Operations 
Analysis  Directorate,  CACOA,  CAC,  Fort  Leavenworth,  for  use  in  the 
Division  86  study. 
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c.  Program  Specifications. 

(1)  Language  and  operating  system.  ARM  is  written  in  standard 
FORTRAN  IV,  with  the  exception  of  a  CDC-specific  DECODE  instruction  in 
subroutine  RDJIFF,  and  currently  runs  on  the  CDC  6500  at  the  TRADOC  Data 
Processing  Field  Office  (DPFO). 

(2)  Program  size.  There  are  43  subroutines  consisting  of 
approximately  3400  lines  of  code.  The  program  requires  a  150  K  Octal 
interactive  password  to  operate. 

(3)  Execution  times.  The  model  has  been  tested  with  a  brigade  set  of 
units  and  requires  3  seconds  of  computer  time  to  process  the  input 
resulting  from  a  JIFFY-produced  4  hours  of  engagement.  A  division  set  of 
units  requires  less  than  15  seconds  of  computer  processing. 

(4)  Program  input.  Program  input  comes  from  the  following  sources. 

(a)  File  Tl,  which  contains  the  data  base  of  ammunition  system 
characteristics  and  unit  ammunition  basic  requirements. 

(b)  File  T2,  which  contains  the  impending  events,  if  any,  from  the 
previous  run. 

(c)  File  T3,  ammunition  usage  file  created  by  an  attrition  model. 

(d)  Input,  supplied  by  the  operator  during  the  run,  which  is  of  three 
types: 

1.  Yes/No  answers  to  select  program  options. 

2.  New  values  for  specific  run  parameters. 

3.  Requests  for  desired  reports. 

(5)  Program  output.  There  are  three  types  of  program  output: 

(a)  At  his  request  the  operator  can  elect  to  print  a  step  by  step 
processing  of  the  model. 

(b)  The  data  base  can  be  displayed  in  part  or  in  total. 

(c)  Reports  can  be  generated  at  operator-specified  control  points  in 
the  processing  to  display  the  system  status. 

d.  Operating  Environment.  ARM  requires  an  interactive  terminal  with 
a  printer  and/or  CRT.  Output  can  be  routed  to  a  highspeed  printer. 
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3.  COMMON  BLOCKS  IN  ARM.  Two  programming  methods  are  used  to  transfer 
data  among  the  ARM  subroutines: 

o  Arrays  and  variables  are  passed  in  the  subroutine  calling  sequence. 

o  Arrays  and  variables  are  stored  in  the  COMMON  blocks. 

a.  Composition  of  COMMON  Block.  The  use  of  labeled  or  named  COMMON 
blocks  makes  it  possible  to  make  available  to  each  subroutine  only  those 
variables  it  uses.  For  quick  reference,  table  1  lists  the  arrays  and 
single  variables  making  up  each  ARM  COMMON  block.  Definitions  of  those 
arrays  and  variables  are  given  in  table  2,  and  table  3  lists  some 
additional  data  and  codes. 


b.  COMMON  Block  Usage  in  ARM.  Table  4  lists  the  COMMON  blocks  used 
by  each  ARM  subroutine.  Table  5  cross-indexes  this  information,  showing 
the  subroutines  using  each  COMMON  block. 

Table  1.  Composition  of  the  ARM  COMMON  Blocks 


Block  Name 

EVENTS 

LOG 


QUENUM 

QUEPNT 


Variables 

JSTAT(6) ,  JEVDS( 1024,4),  IEVS(5,1024) 
IATP(4,30),  IASP(4,41) , 

IUNITC75.69),  ITRUCK(560,7) , 
ITYPE(6,6) ,  IMIX(40,23) ,  INTER(9), 
IRSTME(20,3),  IATPSD(5), 

IDAY,  TIME,  ICSA( 20) ,  LPPAR(5) 
IASPAM(4,20) ,  LUOUT,  TCIST, 

TCILNG,  LOOK ( 17 ) 

IHEAO ( 136 ) 

ITEMS (560) 
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Table  2.  Definitions  of  the  COMMON  Arrays  and  Variables 
CO  WON  3  locks  Variables 

EVENTS  :  Event  handler. 

JSTAT(I) 

1=1,  -  Pointer  to  the  first  event  chronologically 

1=2,  -  Pointer  to  the  last  event  chronologically 

1=3,  -  Pointer  to  the  next  empty  record  to  place 

an  event 

1=4,  -  Total  number  of  events  presently  in 
storage 

1=5,  -  Number  of  additional  events  that  can  be 
placed  in  storage 

1=6,  -  Total  number  of  events  that  can  be  placed 
in  storage. 

JEVDS  (I, J) 

1=1-1024,-  Event  position- in-storage  index 

J=l,  -  Pointer  to  the  position  of  the  next  event 

J=2,  -  Pointer  to  the  position  of 
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Table  2  (continued) 


J=18,  -  Basic  anno  level,  ammo  1 
J-19-21,  -  Ammo  2 
J=22-24,  -  Ammo  3 
J=25-27 ,  -  Ammo  4 
J=2S -30 ,  -  Ammo  5 
IASP(I,J) 

1-1-4,  -  Data  sets  for  (ASP) 
one  through  four. 

J*l,  -  Distance  to  CSA 
Ja2,  -  Distance  to  ATP 
J=3,  -  UTM  Coordinate 
J=4,  -  Empty 

J=5,  -  Number  trucks  to  CSA 

J=6,  -  A  flag  that  =  0  if  the  routine  queue  has 

not  served  a  truck  this  war,  1  otherwise 

J*7,  -  Number  routine  servers  active 

J=8,  -  Number  GSRS  servers  active 

J*9,  -  Routine  queue  number 

J=1Q,  -  GSRS  queue  number 

*J=11,  -  A  flag  that  =  0  if  the  GSRS  queue  has  not 
served  a  truck  this  war,  1  otherwise 
J=12,  -  Number  trucks  in  routine  queue 
*J*13,  -  Number  trucks  in  GSRS  queue 
J*14,  -  Current  ammo  supply,  ammo  1 
Ja15,33  -  Ammo  2  -  Ammo  20 
J*34,41  -  Empty 
I UNIT  (I,  J) 

I  *  1  -  75,  -  Contains  the  data  sets  for  units 
numbered  1  to  75. 

J*l,  -  Type  Unit 

J=2,  -  ATP  number 

J=3,  -  ASP  number 

J=4,  -  Oi stance  to  ATP  in  Km 

J=5,  -  Distance  to  ASP  in  Km 

J*6,  -  UTM  coordinate 

J=7,  -  Jiffy  unit  name 

J=8,  -  First  ammo  type 

J*9,  -  Number  weapons  alive,  First  ammo  type 
J*10,  -  Number  weapons  short  ammo.  First  ammo  type 

J=ll,  -  Number  rounds  short,  (Wpns)  First  ammo  type 

J*12,  -  Current  ammo  supply,  (Wpns)  First  ammo  type 

J*13,  -  Routine  resupply  level,  (Per  Wpn)  First 

ammo  type 

J*14,  -  Critical  resupply  level,  (Per  Wpn)  First 
ammo  type 


*Note:  Not  used  since  each  GSRS  truck  has  its  own  crane  and  does  not  wait  in 
queue. 
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Table  2  (continued) 

J*15 ,  -  Sasic  ammo  level,  (Per  Wpn)  First  ammo  type 
J*16,  -  Amno  on  trucks,  First  ammo  type 
J*17,  -  Number  of  weapons  killed  in  Cl,  First  ammo 
type 

J*18,  -  Number  of  weapons  short  ammo,  First  ammo 
type 

J*19,  -  Total  rounds  short  through  whole  Cl,  First 
anno  type 

Ja20-31,  -  .Second  ammo  type 
J=32-43,  -  Third  amno  type 
Ja44-55,  -  Fourth  amno  type 
J«56 -67 ,  -  Fifth  amno  type 
J=68,  -  Number  of  helicopters  assigned 
J=69,  =  0  If  single  pulse  demand  per  Cl 
=  1  If  multiple  pulses  oer  Cl 
=  N 
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Table  2  (continued) 


INTER ( I) 

1*1,  -  Counter  for  zone  I  trucks  killed  in  INTRDK 
1=2,  -  Counter  for  zone  2  trucks  killed  in  INTRDK 
1=3,  -  Maximum  number  of  trucks  to  be  killed  in 
zone  1 

1=4,  -  Maximum  number  of  trucks  to  be  killed  in 
zone  2 

1=5,  -  Time  to  replace  truck  interdicted  in  zone  1 
1*6,  -  Time  to  replace  truck  interdicted  in  zone  2 
1*7,  -  Modulo  of  trucks  to  be  killed  in  zone  I  and 
zone  2 

1=8,  -  Number  of  zone  1  trucks  entering  INTRDK 
IRSTME  (I9J)"  Number  °f  20ne  2  trucks  entering  INTRDK 

1=1-20,  -  Designates  the  ammunition  type  associated 
with  the  data  set 

J=l,  -  Weapon  set-up  time  in  minutes 
J=2,  -  Load  time  per  round  in  minutes 

T  ,Jf3>  "  Travel  time  to  weapon  in  minutes 
IATPSD(I) 

1=1,  -  Maximum  number  of  servers  at  the  ATP 
1=2,  -  Threshold  1  for  queue  1  at  an  ATP 

1=3,  -  Threshold  2  for  queue  1  at  an  ATP 

1*4,  -  Threshold  1  for  queue  2  at  an  ATP 

lniu  r*5.  *  Threshold  2  for  queue  2  at  an  ATP 

I  DAY 

0,  -  Night 
1,  -  Day 

TIME 

Contains  the  present  battle  time  of  the  simulation 
in  decimal  minutes 

ICSA(I) 

1*1-20,  Contains  the  number  of  rounds  by  20 
ammunition  types,  drawn  from  the  corps  storage  area 
stock  since  the  beginning  of  the  qame. 

LPPAR(I) 

1=1,  -  Total  number  of  ammo  codes  (20) 

1=2,  -  Number  of  ammo  codes  at  ATP  (5) 

1=3,  -  Number  of  maneuver  unit  ammo  codes  at  ATP  (2) 
1=4,  -  Number  of  transports(trucks)  (LT  560) 
l*5*  “  Number  of  helicopters  available  (LT  5601 
IASPAM( I, jj 

1=1-4,  -  Designates  the  ammunition  supply  point 
associated  with  the  data  set. 
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Table  2  (concluded) 


QUENUM 

QUEPNT 


LUOUT 

TCIST 

TCILNG 


Jal-20,  -  The  number  of  rounds  by  ammunition  type 
removed  from  the  ammunition  supply  point 

The  logical  file  for  write  statements;  =  2  if  all 
output  to  CRT,  =  6  if  all  nonoperator  interface 
output  to  a  local  output  file 

Decimal  minutes  battle  time  at  the  start  of  current 
run 


Decimal  minutes  battle  time  lenqth  of  current  run 

LOOK(I) 


1*1-17, 


IHEAO(I) 


Contains  print  control  flag 

a  1  if  want  to  see  all  events  of 
type  I 

a  0  if  do  not  want  to  see  events  of 
type  I 


Ial-136,  -  Contains  the  truck  number  of  the  first 
truck  to  enter  queue  I  that  is  still  in 
queue  I 

ITEMS(I) 

1=1-560,  -  Contains  in  space  I  the  truck  which  is 
next  in  the  same  queue  as  truck  I  is  in 
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Table  3.  ADDITIONAL  DATA  AND  CODES 

Arrmo  Type  Codes: 

1  -  105  mm  (M60-A3/XM1) 

2  -  TOW 

3  -  Powder  Canisters 

4  -  155  HE 

5  -  155  ICMDP 

6  -  155  Smoke 

7  -  155  CLGP 

8  -  8  Inch  HE 

9  -  8  Inch  ICMDP 

10  -  GSRS 

11  -  Mortars 

12  -  DIVAD 

13  -  Hellfire 

14  -  XR-TOW 

15  -  STINGER 

16  -  DRAGON 

17  -  BUSHMASTER 

18  -  EMPTY 

19  -  EMPTY 

20  -  EMPTY 

25  -  Raise  code  for  handling  TOW  vehicles  other  than  the  ITV  due  to  differing 
basic  load  parameters. 

Unit  Type  Codes: 

1  -  Tank  task  force 

2  -  Mech  task  force 

3  -  Armrd  cav  sqdn 

4  -  155  arty  btry 

5  -  8  inch  arty  btry 

6  -  GSRS  btry 

7  -  DIVAD  gun  pit 

8  -  CBT  avn  pit 
Truck  Type  Codes: 

1- 10  ton 

2- 5  ton 

3- 5  ton  with  1  1/2  ton  trailer 

4- 10  ton  w/15  ton  trailer 

5- 22  1/2  ton  stake  and  platform 
6  -  Helicopter,  CH  47 

Truck  Mission  Type  Codes: 

1  -  Unit  truck 

2  -  CSA  -  ATP  link 

3  -  CSA  -  ASP  link 

4  -  ASP  -  ATP  link 

5  -  ASP  -  Unit  (helicopter) 

Truck  Status  Type  Codes: 

1  -  In  unit  queue 

2  -  In  ATP  queue 
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3  -  In  ASP  queue 

4  -  In  transit 

5  -  Unit  truck  going  from  ATP  to  ASP 

6  -  Truck  awaiting  repair 

7  -  Truck  dead  f interdicted) 

QUEUE  NUMBER  QUEUE  TYPE  QUEUE  USE 


1-75  1 
101-104  2 
105-108  3 
109-112  4 
113-116  5 
117-120  6 
121-124  7 
125-128  8 
129-132  9 
133-136  10 


At  each  unit 

At  ATPS  for  CSA-ATP  trucks 
At  ATPS  for  ASP-ATP  trucks 
At  ATPS  for  unit  artillery  server 
At  ATPS  for  unit  maneuver  server 
Not  used 

At  ASPS  for  CSA-ASP  trucks  (Not  Use 
At  ASPS  for  routine  server 
At  ASPS  for  GSRS  server 
Not  used 
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Routine 

ARM  ORIVER 
ASP 

ASPAR1 

ASPARV 

AT? 

ATPAR1 

ATPAR2 

ATPARV 

CONTRL 

CSAARV 

DEMAND 

EDIT 


ENDSIM 

FINTK 

HASPAR 

HEIARV 

IN  IT 

INTRDK 

IQ 

LDPWDR 

LOQKEV 

OPERA 

RDIEXO 

ROJIFF 

READF 

RELOAO 

REPORT 

TRKPUT 

TRKTIM 

UNTARV 

UNTDEP 

CREEVT 

EVINIT 


Table  4.  Use  of  Common  Arrays  and  Variables  by  ARM  Subroutines 

Arrays/Variables 


TIME 

IASP,  I ASP AM,  IDAY,  IMIX,  ITRUCK 
ITYPE,  IUNIT,  LPPAR,  TIME 
IASP,  I ASP AM,  IDAY,  IMIX,  ITRUCK, 

ITYPE,  LPPAR,  TIME 

IASP,  IDAY,  IMIX,  ITRUCK,  TIME 

IASP,  IASP AM,  IATP,  IATPSD,  IDAY,  IMIX, 

ITRUCK,  ITYPE,  IUNIT,  LPPAR,  LUOUT,  TIME 
IATP,  IMIX,  ITRUCK,  LPPAR 
IATP,  IMIX,  ITRUCK,  LPPAR 

IATP,  IDAY,  IMIX,  ITRUCK,  ITYPE,  IUNIT,  LPPAR,  TIME 

IASP,  IATP,  ICSA,  IDAY,  IMIX,  ITRUCK,  ITYPE,  LPPAR,  TIME 
I ASP AM,  IATP,  ICSA,  IDAY,  IMIX,  ITRUCK,  ITYPE,  IUNIT, 
LPPAR,  LUOUT,  TIME 

IASP,  I ASP AM,  IATP,  IATPSD,  ICSA,  IDAY,  IMIX,  INTER, 
IRSTME,  ITEMS,  ITRUCK,  ITYPE,  IUNIT,  LOOK,  LPPAR,  LUOUT, 
TCILNG,  TCIST,  TIME 

Writes  out  log  common  and  queue  pointer  commons 
IMIX,  ITRUCK,  LUOUT 
ITRUCK  LPPAR 

IDAY,  IMIX,  ITRUCK,  ITYPE,  IUNIT,  TIME 
Reads  all  log  and  queue  files  for  restart 
INTER,  ITRUCK,  LUOUT 
None 

IDAY,  IMIX,  ITRUCK,  ITYPE,  TIME 
LOOK 

ITRUCK,  ITYPE,  LUOUT,  TIME 
IUNIT,  TCILNG,  TCIST,  TIME 
IUNIT,  LUOUT,  TCILNG,  TCIST,  TIME 
None 

IASPAM,  IMIX,  IRSTME,  ITRUCK,  IUNIT,  LUOUT,  TIME 
IASP,  IATP,  ICSA,  ITRUCK,  ITYPE,  IUNIT,  IPPAR,  LUOUT 
None 

ITRUCK,  ITYPE,  LPPAR 

IMIX,  ITRUCK,  IUNIT,  LPPAR,  TIME 

IDAY,  IMIX,  ITRUCK,  ITYPE,  IUNIT,  LPPAR,  TIME 

NONE 

Reads  unprocessed  events  from  T2  into  common  events 


12 


EVSTOP 

3ETEVT 

GETQUE 

NEXTEV 

NXTQUE 

PUTEVT 

PUTQUE 

QINIT 

SCHED 

SETQUE 


Writes  unprocessed  events  onto  tape  2  from  common  event 

IEVS,  JEVDS,  JSTAT 

IPNT,  NHEAO,  { ITEM) ( IHEAD) 

None 

None 

IEVS,  JEVDS,  JSTAT 
IPNT,  ITEM,  ( IHEAD) (NHEAD) 

IEVS,  JEVDS,  JSTAT 
None 

IPNT,  NHEAD,  ( ITEM) ( IHEAD) 
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Table  5.  Use  of  COMMON  Blocks  by  the  ARM  Subroutines 


COMMON  Array/Vari able 


Using  subroutines 


I  ASP 
IAS PAM 
I  ATP 
IATPSD 
ICSA 
IOAY 

IHEAO 

IMIX 


INTER 

IRSTME 

ITEM 

ITRUCK 


ITYPE 

IUNIT 

LOOK 

LPPAR 

LUOUT 
TC ILNG 
TCI  ST 
TIME 


IEVS 

JEVOS 

JSTAT 


ASP,  ASPAR1,  ASPARV,  ATP,  CSAARV,  EDIT,  REPORT 

ASP,  AS PARI,  ATP,  OEMAND ,  EDIT,  RELOAD 

ATP,  ATPAR1,  ATPAR2,  ATARAV,  CSAARV,  DEMAND,  EDIT,  REPO! 

ATP  EDIT 

CSAARV,  DEMAND,  EDIT,  REPORT 

ASP,  ASPARV,  ATP,  ATPARV,  CSAARV,  DEMAND,  EDIT,  HELARV 
LDPWOR,  UNTDEP 
GETQUE,  PUTQUE,  SETQUE 

ASP,  ASPAR1 ,  ASPARV,  ATP,  ATPAR1,  ATPAR2,  ATPARV, 

CSAARV,  DEMAND,  EDIT,  FINTK,  HELARV,  LDPWDR,  RELOAD 

UNTARV,  UNTDEP 

EDIT,  INTRDK 

EDIT,  RELOAD 

GETQUE,  PUTQUE,  SETQUE 

ASP,  ASPAR1,  ASPARV,  ATP,  ATPAR1,  ATPAR2,  ATPARV, 

DEMANO,  EDIT,  FINTK,  HASPAR,  HELARV,  INTRDK,  LDPWDR, 

OPERA,  RELOAD,  REPORT,  TRKTIM,  UNTARV,  UNTDEP 

ASP,  ASPAR1,  ATP,  ATPARV,  CSAARV,  DEMAND,  EDIT,  HELARV, 

LDPWDR,  OPERA,  REPORT,  TRKTIM,  UNTDEP 

ASP,  ATP,  ATPARV,  DEMAND,  EDIT,  HELARV,  RELOAD,  REPORT, 

UNTARV,  UNTDEP 

EDIT,  LOOKEV 

ASP,  ASPAR1,  ATPAR1 ,  ATPAR2 ,  ATPARV,  CSAARV,  DEMAND, 
EDIT,  HASPAR,  REPORT,  TRKTIM,  UNTARV,  UNTDEP 
ATP,  OEMAND,  EDIT,  INTRDK,  OPERA,  RELOAD,  REPORT 
EDIT,  RDIEXO,  RD J IFF 
EDIT,  RDIEXO,  RDJIFF 

ARM  DRIVER,  ASP,  ASPAR1,  ASPARV,  ATP,  ATPARV,  CSAARV, 

DEMAND,  EDIT,  HELARV,  LDPWDP,  OPERA,  RDIEXO,  RDJIFF, 

RELOAO,  UNTARV,  UNTDEP 

GETEVT,  PUTEVT,  QINIT,  EVINIT,  EVSTOP 

GETEVT,  PUTEVT,  QINIT,  EVINIT,  EVSTOP 

GETEVT,  PUTEVT,  QINIT,  EVINIT,  EVSTOP 
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4.  PROGRAM  STRUCTURE  -  A  MACRO  VIEW 

a.  Purpose  of  This  Report  Section.  This  section  provides  an  overview  of  the  ARM 
subroutine  structure.  Information  is  presented  in  the  following  order. 

.  Outline  of  main  driver  routine,  with  operational  flow  diagrams. 

.  Additional  description  of  overall  processing 

.  List  of  subroutines  called  by  each  subroutine 

.  The  cross  reference  list  of  the  callers  of  each  subroutine 

b.  Main  Program  Operations.  The  basic  control  program  in  ARM  is  the  mainline 
driver  PROGRAM  ARM.  Its  principal  functions  as  shown  in  figure  2  are  as  follows: 

.  Initi alize  the  files 

.  Obtain  the  next  event 

.  Call  in  the  proper  subroutine  to  process  the  next  event  / 

c.  ARM  Subroutine  Structure. 

(1)  Major  subroutine  groups.  ARM. consists  of  43  routines.  Table  6  shows  the 
major  grouping  of  routines  into  the  following  categories: 

.  Event  storage/retrieval 

.  Event  functional  processing 

.  Support  special  purpose  routines 

(2)  Subordinate  calling  pattern  in  ARM.  This  review  of  the  ARM  structure  is 
completed  by  the  exhibition  of  the  subroutine  calling  pattern.  Table  7  is  the  list  o- 
routines  called  by  each  routine.  Table  3  is  the  cross-ref erenced  routines  calling  th< 
list  of  routines. 
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SET 

COMMONS 

DIMENSIONS 


Figure  2.  Program  Arm 


GROUP 


Table  5.  Major  Grouping  of  Routines 

Routines 


Event  Storage/Retrieval 


GETEVT,  NEXEVT,  PUTEVT 


Event  Functional 
Processi ng 


ASP,  ASPARV,  ASPAR1,  ATP,  ATPARV, 
ATPAR1,  ATPAR2,  CONTRL,  CSAARV,  DEMAND, 
ENDSIM,  HASPAR,  HELARV,  RELOAD,  REPORT, 
UNTARV,  UNTDEP 


Support  Special  Purpose 
Routi nes 


CREEVT,  EDIT,  EVINIT,  EVSTOP,  FINTK, 
GETQUE,  INIT,  INTRDK,  IQ,  LDPWDR, 
LOOKEV,  OPERA,  NXTQUE,  PUTQUE,  QINIT, 
RANF,  RDIEXO,  RDJIFF,  READF,  SCHED, 
SETQUE,  TRKPUT,  RANF,  TRKTIM 
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Table  7.  Subroutine  Calls  in  ARM 


Program  ARM  Calls: 

GETEVT  Calls 

None 

ASP 

NEXEVT  Calls 

ASPARV 

GETEVT 

ASPAR1 

PUTEVT  Calls 

ATP 

None 

ATPARV 

ATPAR1 

ATPAR2 

ASP  Calls: 

CONTRL 

GETQUE 

CSAARV 

INTRDK 

DEMAND 

IQ 

ENOSIM 

OPERA 

EV INTT 

SCHED 

EVSTOP 

HASPAR 

ASPARV  Calls: 

HELARV 

IQ 

IN  IT 

PUTQUE 

LOOKEV 

SCHED 

NEXTEV 

RELOAD 

ASPAR1  Calls: 

REPORT 

INTRDK 

UNTARV 

OPERA 

UNTDEP 

SCHED 

RELOAD  Calls: 

EDIT  Calls: 

FINTK 

REA  OF 

INTROK 

IQ 

EVINIT  Calls: 

MINO 

QINIT 

SCHED 

EVSTOP  Calls: 

REPORT  Calls: 

None 

TRUCK 

FINTK  Calls: 

UNTARV  Calls: 

GETQUE 

IQ 

PUTQUE 

PUTQUE 

SCHED 

IN  IT  Calls: 

GETQUE  Calls: 

CONTRL 

RD JIFF 

UNTOEP  Calls: 

SCHED 

INTRDK 

TRKTIM 

OPERA 

SCHED 

INTRDK  Calls: 


ATP  Calls: 

CSAARV  Calls: 

FINTK 

INTRDK 

GETQUE 

OPERA 

INTRDK 

SCHED 

IQ 

LDPWDR 

OPERA 

DEMAND  Calls: 

RDIEXO 

OPERA 

SCHED 

RDIEXO 

SCHED 

ATPAR1  Calls: 

ENDSIM  Calls: 

IQ 

None 

PUTQUE 

HASPAR  Calls: 

ATPAR2  Calls: 

None 

IQ 

PUTQUE 

HELARV  Calls: 

OPERA 

ATPARV  Calls: 

SCHED 

INTRDK 

OPERA 

PTQUE 

SCHED 

SCHED 

RDIEXO  Calls: 

SCHED 

IQ  Calls: 

None 

LDPWDR  Calls: 

RDJIFF  Calls: 

FINTK 

EOF 

INTRDK 

SCHED 

IQ 

OPERA 

READF  Calls: 

EOF 

EOF 

SCHED 

FLOAT 

LOOKEV  Calls: 

None 

NXTQUE  Calls: 

SCHED  Calls: 

None 

CONTRL 

LOOKEV 

OPERA  Calls: 

PUTEVT 

None 
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None 


CONTRL  Calls: 
CREEVT 
EDIT 
REPORT 
SCHED 
TRKPUT 

CREEVT  CALLS: 
REAOF 
SCHED 


SETQUE  Calls: 

TRKPUT  Calls: 

GETQUE  None 

NXTQUE 

PUTQUE 

READF 

SETQUE 

PUTQUE  Calls: 

None 


TRKTIM  Calls: 
RANF 


QUINT  Calls: 
None 
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Table  S.  Calling  Subroutines  in  ARM 


Routine 

Called  bv 

ARM  PROGRAM  (ARM-P) 

NONE 

NEXTEV 

ARM-P 

GETEVT 

NEXEVT 

PUTEVT 

SCHED 

ASP 

ARM-P 

ASPARV 

ARM-P 

ASPAR  1 

ARMY 

ATP 

ARM-P 

ATPARV 

ARM-P 

ATPAR1 

ARM-P 

ATPAR2 

ARM-P 

CONTRL 

ARM-P 

CSAARV 

ARM-P 

DEMAND 

ARM-P 

ENOSIM 

ARM-P 

HASPAR 

ARM-P 

HELARV 

ARM-P 

RELOAO 

ARM-P 

REPORT 

ARM-P,  CONTRL 

UNTARV 

ARM-P 

UNTDEP 

ARM-P 

CREEVT 

CONTRL 

EDIT 

CONTRL 

EVINIT 

CONTRL 

EVSTOP 

ARM-P 

FINTK 

ARM-P 

GETQUE 

ASP,  ATP,  FINTK 
TRKPUT, 

INITD 

ARM-P 

INTRDK 

ASPARV,  ATPARV, 
CSAARV, 

RELOAD,  UNTDEP, 
LPDWDR 

Routine 

Called  by 

IQ 

ASP,  ATP,  ATPAR1,  ATPAR2 
RELOAD,  LDPWDR,  UNTARV 

LDPWDR 

ATP,  ATPARV, 

LOOKEV 

ARM-P,  SCHED 

NEXTEV 

ARM-P 

NXTQUE 

TRKPUT 

OPERA 

ASP,  ASPAR 1,  ATP, 

ATPARV,  CSAARV, 

DEMAND,  HELARV, 

UNTDEP,  LDPWDR 

PUTQUE 

ASPARV,  ATP,  ATPARV, 
ATPAR1 ,  ATPAR2 

CSAARV,  DEMANDHELARV, 

QINIT 

EVINIT 

RANF 

TRKIEM 

RDIEXO 

ASPAR1 ,  UNTARV,  FINTK, 

RDJIFF 

LDPWDR,  TRKPUT 

READF 

EVINIT,  CREEVT 

SCHED 

EDIT,  TRKPUT 

ASP,  ASPARV,  AS PARI ,  ATP, 
ATPARV,  CSAARV,  DEMAND, 
HELARV,  RELOAD,  UNTARV, 
UNTDEP,  INIT,  LDPWDR, 
RDIEXO,  RDUIFF,  CNTRL 


SETQUE 

TRKPUT 

TRKPUT 

CONTRL 

TRKTIM 

INIT 

TRUCK 

REPORT 

5.  DESCRIPTIONS  OF  THE  INDIVIDUAL  SUBROUTINES.  Descriptions  of  the 
individual  subroutines  are  given  in  this  section.  The  following 
information  is  given  for  each  routine: 

o  Name 
o  Purpose 
o  COMMON  blocks 

o  Subroutines  called  by  this  routine 
o  Subroutines  calling  this  routine 
o  Variables  in  calling  sequence 
o  Local  arrays 
o  Subroutine  functions 
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a.  ROUTINE:  ARM  Program-No  Parameters 

PURPOSE:  To  control  the  overall  system  flow  for  the  ARM 

COMMON  SLOCKS:  LOG 

QUENUM 

QUEPNT 

CALLS: 

ASP 

ASPARV 

ASPAR1 

ATP 

ATPARV 

ATPAR1 

ATPAR2 

CONTRL 

CSAARV 

DEMAN 0 

ENDSIM 

EVINIT 

EVSTOP 

HASPAR 

HELARV 

INIT 

LOOKEV 

NEXTEV 

RELOAO 

REPORT 

UNTARV 

UNTDEP 

IS  CALLED  BY:  Operator 
CALLING  PARAMETERS:  NONE 
LOCAL  ARRAYS: 

IPARM(5)  —  Storage  array  for  carrying  event  parameters  to  the  event 
processing  routines. 


FUNCTIONS: 


Initializes  event  queues. 

Calls  INIT  to  enable  setting  of  parameters  for  this  ARM  cycle. 
LOOP  LOGIC:  Retrieves  the  next  chronological  event. 

Passes  control  to  appropriate  routine  to  process  the  event. 
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b.  SUBROUTINE:  GETEVT 

PURPOSE:  Retrieves  the  next  event  chronologically  from  the  event  queue 
COMMON  BLOCKS:  EVENTS 
CALLS:-  NONE 


IS  CALLED  BY:  NEXTEV 


CALLING  PARAMETERS: 


IEVT(5)  -  5  parameters  describing  the  event. 

ITH  -  Integer  minutes  of  battle. 

ITS  -  Decimal  minutes  of  battle  minus  ITH  times  3600  and 

i ntegerized. 

IHIT  -  0  if  no  events  in  queue,  1  if  event  in  the  queue. 
LOCAL  ARRAY: 


COMMON 


event. 


JFORE  (1024)  -  Equivalenced  to  first  1024  words  of  JEVDS  of 

EVENTS  and  points  to  the  previous  event. 

JBACK  (1024)  -  Equivalenced  to  the  second  1024  words  of  JEVDS 
of  COMMON  EVENTS  and  points  to  the  follow-on 


FUNCTIONS: 


Retrieves  the  5  parameters  of  the  next  event. 

Retrieves  the  time  of  the  next  event  occurring. 

Updates  the  forward  and  backward  pointers  to  reflect  the  next 
retrievable  event. 
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c.  SUBROUTINE:  NEXTEV 


PURPOSE:  Interface  between  ARM  driver  routine  and  the  GETEVT  routine  to 
retrieve  the  next  event. 

COMMON  BLOCKS:  NONE 

CALLS:  GETEVT  ‘  •„ 

IS  CALLED  8Y:  ARM  Driver 
CALLING  PARAMETERS: 

ITYPE  -  The  event  type. 

IPARM  (5)  -  The  5  parameters  describing  the  event. 

TIME  -  Present  Simulation  Time. 

LOCAL  ARRAYS:  NONE 
FUNCTIONS: 

Calls  GETEVT  to  retrieve  event. 

Computes  a  single  time  from  the  two  times  stored  in  the  event 
logic. 
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d.  SUBROUTINE:  PUTEVT 


PURPOSE:  Places  an  event  record  in  the  queue  in  chronological  order  and 
updates  the  queue  pointer  tables.  If  the  placement  is  successful  the  flag 
(I CHECK)  is  set  equal  to  1. 

COMMON  BLOCKS:  EVENTS 

CALLS:  NONE 

IS  CALLED  BY:  SCHED 

CALLING  PARAMETERS:  IEVT ( 5 )  -  Contains  the  5  parameters  describing  the 

event  to  be  stored. 

ITH  -  Contains  the  integer  portion  of  the  event 
time. 

ITS  -  Contains  the  decimal  portion  of  the  event 
time  multiplied  by  3600. 

ICHECK  -  0  if  no  room  on  the  file,  1  if  there  is 
room  on  the  file. 

LOCAL  ARRAYS: 

JFORE  (1024)  -  Equivalenced  to  the  first  1024  words  of  JEVDS  and. 
points  to  the  previous  event. 

JBACK  (1024)  -  Equivalenced  to  the  second  1024  words  of  JEVDS  and 
points  to  the  subsequent  event. 

JTIME  (1024,  2)  -  Equivalenced  to  the  last  2048  words  of  JEVDS  and 
keeps  the  time  data  associated  with  the  event. 

FUNCTIONS: 

Checks  to  see  if  space  is  available. 

Places  event  record  in  ARRAY  IEVS  in  COMMON  EVENTS. 

Update  pointers  in  event  directory. 
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SUBROUTINE  PUTEVT(IEVT,  ITH,  ITS,  ICHECK) 


C  POTEVT  PLACES  AN  EVENT  RECORD  IN  THE  QUEUE  IN  CHRONOLOGICAL 
C  ORDER  AND  UPDATES  THE  QUEUE  DIRECTORY.  ICHECK  FLAG  SET 
C  IF  INSERT  WAS  UNSUCCESSFUL. 

C  BOB  DAVISON  1978 
C 


COMMON/ EVENTS /JSTAT(6) ,JEVDS(1024 ,4) ,  IEVS(5 ,1024) 

DIMENSION  I£VT(5 ) ,  JFORE ( 1024 )  ,J3ACK(  1024)  ,JTIME(  1024,2) 
EQUIVALENCE  (JFORE(l) ,JEVDS( 1 , 1) ) , (JBACK( 1 ) ,JEVDS( 1 ,2 ) ) , 

Z  (JTIME( 1,1 ) ,JEVDS( 1,3 )) , (JSTAT( 1 ) , JFIRST) , (JSTAT(2) ,JLAST) 
Z  (JSTAT(3) ,JEMPTY ) , (JSTAT(4) ,NUMEVT) , (JSTAT(5) ,NEMPTY) , 

4  (JSTAT(6) ,MAXEVT) 

C  CHECK  IF  SPACE  AVAILABLE  ..  IF  NONE,  RETURN 
ICHECK  =  1024  -  NEMPTY 
IF(NEMPTY.LE.O)  GOTO  400 
ICHECK=0 


LSAVE=JFOR£(JEMPTY) 

C  PUT  EVENT  RECORD  IEVT  IN  IEVS 
DO  20  IN  *  1,5 
IEVS ( IN, J EMPTY)  =  IEVT(IN) 

20  CONTINUE 

C  IF  NO  EVENTS  IN  QUEUE,  PERFORM  THE  FOLLOWING 
IF  CNUMEVT.GE. 1)  GOTO  200 
JFuRE(JEMPTY)*Q 
J8ACK(JEMPTY)*0 
JFIRST-JEMPTY 
J  LAST*  J  EMPTY 
GOTO  3 SO 

C  IF  ONE  EVENT  IN  QUEUE,  PERFORM  THE  FOLLOWING 
200  CONTINUE 

ITFH*JTIME( JFIRST, 1) 

ITFS*JTIME(JFIRST,2) 

IF(NUMEVT.GT.l)  GOTO  300 
C  IF  LOWEST  TIME  EVENT,  PERFORM  THE  FOLLOWING 
IF( ITH.GT. ITFH)GO  TO  210 
IF (ITH.EQ. ITFH.AND. ITS.GE. ITFS)GO  TO  210 
JFORE(JEMPTY)*JFIRST 
JBACK(JEMPTY)*0 
JBACK(JFIRST)*UEMPTY 
JLAST*OFIRST 
JFIRST=J EMPTY 
GOTO  380 

C  ELSE  THIS  TIME  IS  EQUAL  TO  OR  LATER  THAN  THE  LAST  EVENT 
210  CONTINUE 

JF0RE(JEMPTY)*O 
J8ACK(JEMPTY)a JFIRST 
JFORE(JFIRST)sJ EMPTY 
JLAST«JEMPTY 
GOTO  380 


C  IF  TWO  OR  MORE  EVENTS  IN  QUEUE,  PERFORM  THE  FOLLOWING 
300  CONTINUE 

C  IF  EVENT  TIME  IS  LESS  THAN  FIRST  EVENT,  MAKE  IEVT  THE  FIRST  EVENT 
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IF ( ITH.GT. ITFH)QO  TO  310 

IF(ITH.Ef).  ITFH  .AND.  ITS.GE .  ITFS)GO  TO  310 

JFORE (JEMPTY)=JFIRST 

JBACK(JEMPTY)=0 

JBACK(JFIRST)=JEMPTY 

JFIRST=J EMPTY 

GOTO  380 

EyF!2T™E  IS  GREATER  THAN  OR  EQUAL  TO  LAST  EVENT,  MAKE  IEVT  LAST 
JiO  CONTINUE 

ITLH= JTIME ( JLAST, 1 ) 

ITLS=UTIME(JLAST,2) 

IF(ITH.LT.ITHLH)GO  TO  320 

IF( ITH . EQ. ITLH.AND.ITS.LT. ITLS)G0  TO  320 

JF0RE(JEMPTY)=0 

JBACK(JEMPTY)=JLAST. 

JFORE (JLAST)=JEMPTY 
JLAST=JEMPTY 
GOTO  380 


C  EVENT  TIME  IS  BETWEEN  JTIME(JFIRST)  AND  JTIME(JLAST) 

320  CONTINUE 

NUM=NUMEVT-1 

C  IF  EVENT  TIME  CLOSER  TO  FIRST,  START  SEARCH  AT  FIRST  EVENT 
IF( ( ITH- ITFH )-( ITLH- ITH) ) 326 ,325 ,350 

325  IF((ITS-ITFS)-( ITLS-ITS) )326,326,350 

326  IND1=JFIRST 
IT1H=ITFH 
IT1S=ITFS 

IND2=JF0RE(JFIRST) 

IT2H= JTIME ( IND2 ,1 ) 

IT2S=JTIME ( IN02 ,2 ) 

00  330  1=1, NUM 

IF ( ITH .GT. IT2H )G0  TO  327 

IF( ITH. EQ. IT2H. AND. ITS.GE. IT2S)G0  TO  327 

GO  TO  340 

327  IND1=IND2 
IT1H=IT2H 
IT1S=IT2S 

IND2* JF  ORE ( I ND2 ) 

I T2H*  J  T IM  E ( I ND  2 , 1) 

IT2S= JTIME ( IND2 , 2 ) 

330  CONTINUE 
ICHECK*2 
GO  TO  400 

340  JFORE ( IND1 )=JEMPTY 
JBACK(JEMPTY)=IND1 
JFORE ( JEM PTY)*IND2 
JBACK( IND2)=JEMPTY 
GOTO  380 

C  EVENT  TIME  CLOSER  TO  LAST,  START  SEARCH  AT  LAST  EVENT 

350  IND1-JLAST 
IT1H-ITLH 
IT1S-ITLS 
IND2*JBACK( JLAST) 
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IT2H=JTIME(IND2,1) 

IT2S=JTIME( IND2 ,2) 

DO  360  1=1, NUM 
IF(ITH.LT. IT2H)G0  TO  355 
IF ( ITH. EQ. IT2H.AND.ITS.LT. I T2S)G0  TO  355 
GO  TO  370 
355  IND 1=IND2 

IT1H=IT2H 
IT1S=IT2S 
IND2-0BACK(IND2) 

IT2H=JTIME( IND2,1) 

IT2S=UTIME ( IND2 ,2 ) 

360  CONTINUE 
ICHECK=2 
GOTO  400 

370  JF0RE( IND2)=JEMPTY 
JBACK ( JEMPTY ) = IND2 
JFORECJ EMPTY)* IND 1 
JBACK(IND1)=U  EMPTY 

C  PERFORM  THE  FOLLOWING  FOR  ALL  EVENTS 
380  CONTINUE 

JTIME(JEMPTY,1)=ITH 
JTIME(JEMPTY,2)=ITS 
NUMEVT=NUMEVT+1 
NEMPTY=NEMPTY-1 
JEMPTY=LSAVE 
400  RETURN 
END 
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a.  SUBROUTINE:  ASP 

PURPOSE:  Services  the  unit  trucks  from  the  queues  and  maintains 
Ammunition  Supply  Point  (ASP)  bookkeeping. 

COMMON  BLOCKS:  LOG 

CALLS : 

GETQUE 

INTRDK 

OPERA 

SCHED 

IS  CALLED  BY:  ARM  Driver 
CALLING  PARAMETERS 

IPARM(5)  -  (1)  —  1  if  routine  queue,  2  if  GSRS  queue 
-  (2)  —  ASP  Number 

LOCAL  ARRAYS:  None 
FUNCTIONS: 

Retrieve  truck  from  queues;  If  no  truck,  have  false  event, 
schedule  another  and  return. 

Determine  arrmunition  mix,  load  time. 

Record  ammunition  used  by  incrementing  IASPAM  and  decrementing 
I  ASP. 

Compute  travel  time. 

Check  for  truck  failure  and/or  interdiction. 

Schedule  truck  to  arrive  back  at  the  unit. 

Schedule  the  next  ASP  event  for  this  queue. 
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f.  SUBROUTINE:  ASPAR  1 


PURPOSE:  Processes  an  Anmunition  Transfer  Point  (ATP)  truck  arriving  at 
the  Anmunition  Resupply  Point  (ASP). 

COMMON  8 LOCKS:  LOG 

CALLS:  INTRDK 
OPERA 
SCHED 

IS  CALLED  BY:  ARM  Driver. 

CALLING  PARAMETERS :  IPARM(5)  -  (1)  —  ATP  Number 

(2)  —  TRUCK  Number 

(3)  —  ASP  Number 

LOCAL  ARRAYS:  None 
FUNCTIONS: 


Determine  the  type  ammunition  on  the  truck  and  decrement  IASP 
and  increment  IASPAM. 

Check  for  truck  failure  and  interdiction. 

Schedule  arrival  back  at  the  ATP  as  appropriate. 
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1  SUBROUTINE  ASPAR1  (IPARM) 

C****  EVENT  AS PARI  —  ARRIVAL  OF  ASP  TRUCK  AT  ASP  (FROM  ATP) 

C 

C****  J.  FOX  JAN  79 
5  C 

C****  IPARM(l)  —  ATP  NUMBER 
C****  IPARM(2)  —  TRUCK  NUMBER 
C****  IPARM(3)  —  ASP  NUMBER 
C 

10  C***+  SCHEDULES  —  ATPAR2,  ARRIVAL  OF  ASP  TRUCK  AT  ATP 

C 

C**+*  CHECKS  —  DELAY  DUE  TO  MTBF  AND  INTERDICTION 
C 

COMMON  /LOG/  IATP(4,30),  IASP(4,41),  IUNIT(75,69) , 

Z  ITRUCK(560,7) ,  ITYPE(6,6),  IMIX(40,23),  INTER(9) , 

Z  IRSTME  (20,3),  IATPSD(5),  IDAY,  TIME, 

$  ICSA(20),  LPPAR(5) ,  IASPAM(4,20) ,  LUOUT,  TCIST,  TOILING,  L00K(17) 

DIMENSION  IPARM(5) 

C****  LOCAL  VARIABLES  DEFINITION 
20  C  MIX  -  AMMO  ON  TRUCK  INDEX  TO  IMIX 

C  IND  -  INDEX  FOR  AMMO  INVENTORY  CONTROL  IN  IASP 
C  TRTM  -  TRAVEL  TIME  TO  ATP 

C****  JLOOP  -  DO  LOOP  TOP  FROM  LPPAR  EQUAL  TO  NUMB  OF  AMMO  CD  AT  ATP 
C***"*  TKSP  -  TRUCK  SPEED 
25  C  ITKTYP  -  TRUCK  TYPE 

C  IFAIL  -  TIME  LOST  DUE  TO  TRUCK  FAILURE 

C  TMIND  -  TIME  LOST  DUE  TO  INTERDICTION 

C****  TMLD  -  TIME  TO  LOAD  AMMO  AT  ASP 
C  TOTTIM  -  TIME  OF  ARRIVAL  AT  ATP 
30  C  FIND  AMMO  MIX  INDEX  ON  THE  TRUCK  -  MIX 

MIX  -  ITRUCK  (IPARM(2) ,5) 

C  DECREMENT  ASP  AMMO 

JLOOP  *  LPPAR(2) 

DO  5  I  *  1, JLOOP 
35  INO  -  1+13 

IASP ( IPARM(3 ) ,  IND)  =  IASP(IPARM(3) ,IND)  -  IMIX(MIX,I) 

C  INCREMENT  AMMO  USED  FROM  ASP 

IAS PAM  (IPARM(3) ,1 )  *  IASPAM(IPARM(3) ,1)  +  IMIX(MIX,I) 

5  CONTINUE 

40  C  SCHEDULE  ATPAR2 ,  COMPUTE  NECESSARY  PARAMETERS 

ITKTYP  -  ITRUCK  (IPARM(2),1) 

TKSP  -  ITYPE( ITKTYP, IDAY+3) 

TRTM  *  60  *  IASP(IPARM(3) ,Zl  /TKSP 
C  COMPUTE  TIME  LOST  DCE  TO  TRUCK  FAILURE 
CALL  0PERA(IPARM(2) ,TRTM,TFAIL) 

C  COMPUTE  INTERDICTION  TIME  LOST 
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50 


55 


60 


65 


CALL  INTRDK(IPARM(2) ,TMIND) 

C  CONSIDER  LOAD  TIME  AT  ASP  WHICH 
TMLD  =  IM IX ( M IX , 23 ) 

C****  IF  NO  INTERDICTION,  BYPASS 
IF  (TMIND  .LE.  0)G0  TO  15 
C****  DECREMENT  AMMO  AGAIN  SINCE  LOST 
C****  ADD  ANOTHER  LOAD  TIME 
JLOOP  =  LPPAR(2) 

DO  10  I  *  1, JLOOP 
IND  *  I  +  13 


MIGHT  BE  ZERO 


A  TRUCK  LOAD 


IASP ( IPARM ( 3 ) , IND ) 
IASPAM(IPARM(3),I) 
10  CONTINUE 


*  IASP 1 IPARM(3) , IND)  -  IMIX(MIX,I 
a  IASPAM( IPARM(3 ) , I )  +  IMIX  (MIX, 


) 

I) 


TMIND  =  TMIND  +  TMLD 
15  CONTINUE 

SCHEDULE  ARRIVAL  AT  ATP  AT  TIME  TOTTIM 
TOTTIM  =  TIME  +TRIM  •+  TMIND  +  TFAIL  +  TMLD 
ITRUCK(IPARM(2) ,6)  *  100 
CALL  SCHED  (11, IPARM, TOTTIM) 


RETURN 

END 
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g.  SUBROUTINE:  ASPARV 

PURPOSE:  To  process  the  arrival  of  a  unit  truck  at  the  Amnunition 
Resupply  Point  (ASP) 

COMMON  BLOCKS:  LOG 

CALLS:  PUTQUE 
SCHED 

IS  CALLED  BY:  ARM  Driver 

CALLING  PARAMETERS:  IPARM  (5)  -  (1)  —  Unit  Number 

(2)  —  Truck  Number 

(3)  —  ASP  Number 

LOCAL  ARRAYS:  None 
FUNCTIONS: 

Determines  ammunition  mix  on  truck. 

Determines  if  truck  should  be  in  GSRS  or  routine  queue. 

Places  truck  in  proper  queue. 

Schedules  ASP  event  if  this  is  the  first  truck  in  the  routine  queue 
or  is  a  GSRS  truck. 
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h.  SUBROUTINE:  ATP 

PURPOSE:  Services  a  unit  truck  waiting  in  the  Ammunition  Transfer  Point 
(ATP)  queue  and  updates  the  bookeeping  files  as  to  ATP  status. 

COMMON  BLOCKS:  LOG 

CALLS:  FINTK 
GETQUE 
INTRDK 
IQ 

LDPWOR 

OPERA 

PUTQUE 

SCHED 

IS  CALLED  BY:  ARM  Oriver 

CALLING  PARAMETERS:  IPARM  (5)  -  (1)  -  1  if  artillery  queue,  2  if 
maneuver  queue 

(2)  —  ATP  Number 

LOCAL  ARRAYS:  IIPARM(5)  -  Used  to  schedule  other  events. 

FUNCTIONS: 

Determine  if  servers  require  shifting  from  one  queue  to 
another. 

Obtain  truck  from  queue;  if  no  truck  schedule  another  look  (false 
event)  5  minutes  later  and  return. 

Determine  the  type  of  ammunition  needed. 

Unload  from  ASP-ATP  truck  if  available,  else  unload  from  CSA-ATP 
truck 

If  empty  ASP-ATP  or  CSA-ATP  truck  send  for  refill. 

If  artillery  ammunition  (4  or  5),  load  powder  cylinders  (type  3) 
also,  schedule  truck  back  to  unit. 

Check  failure  and  interdiction  for  all  trucks  leaving  the  ATP. 
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SUBROUTINE  ATP  (IPARM) 
C****  EVENT  ATP  —  SERVICE  OF 


TRUCK  FROM  QUEUE  AT  ATP. 


****  J.  FOX  JAN  79 


**** 

'k'kirk 


IPARM(l)  —  I  =  ARTILLERY  QUEUE,  2  =  MANEUVER  QUEUE 
I PARM ( 2 )  —  ATP  NUMBER 

SCHEDULES  —  CSAARV,  ARRIVAL  OF  CSA-ATP  TRUCK  AT  CSA 
UNTARV ,  ARRIVAL  OF  TRUCK  AT  UNIT 
ASPAR1 ,  ARRIVAL  OF  ASP-ATP  TRUCK  AT  ASP 
ATP,  SERVICE  OF  TRUCK  FROM  QUEUE  AT  ATP 


c**** 

C 

c**** 


z 

z 

$ 


(1)  TAKES  TRUCK  OUT  OF  ITS  QUEUE 

(2)  CALCULATES  LOAD  TIME  AS  FUNCTION  OF  LOAD  MIX 
NUMBER  AND  NUMBER  OF  SERVERS  ACTIVE  FOR  THIS  OUEUE 


CHECKS  —  DELAY  IN  ARRIVAL  DUE  TO  MTBF  AND  INTERDICTION. 

COMMON  /LOG/  IATP(4,30),  IASP(4,41),  IUNIT(75,69), 

ITRUCK(560,7) ,  ITYPE(6,6),  IMIX(40,23),  INTER(9 j, 

IRSTME(20,3) ,  IATPSD(5),  IDAY,  TIME, 

DIMEBIoS’ip™??)51'  IASPAM(4'20)’  LU0UT'  TCIST-  TCILNG.  >-OOK(17) 


C  LOCAL  VARIABLE  DEFINITION 

C  NUMQ  -  QUEUE  TO  BE  SERVED 

C  NUMTK  -  TRUCK  TO  BE  SERVED 

C  NUMART  -  NUMBER  OF  ARTY  QUEUE  SERVERS 

C  NUMMAN  -  NUMBER  OF  MANEUVER  AMMO  SERVERS 

C  NINC  -  NUMBER  OF  FORKLIFT  FROM  INACTIVE  TO  ACTIVE 

C  MIX  -  INDEX  OF  AMMO  MIX  ON  TRUCK 

C  NRNDSN  -  NUMBER  OF  ROUNDS  NEEDED  BY  THE  TRUCK  NUMTK 

C  IRNTYP  -  TYPE  OF  ROUNDS  NEEDED  BY  NUMTK 

C  I PROG  -  EVENT  TYPE  TO  BE  SCHEDULED 

C  JLOOP  -  DO  LOOP  TOP  FROM  LPPAR  =  NUM  OF  AMMO  CD  AT  ATP 

C  NASP  -  ASP  NUMBER  THAT  THIS  ATP  BELONGS  TO 

C  NFKLK  -  NUMBER  OF  FORK  LIFTS  SERVING  QUEUE 

C  NRND  -  NUMBER  OF  POWDER  CHARGES  NEEDED 

C  NASPQ  —  NUMBER  OF  THE  ASP:-: ATP  TRUCK  QUEUE 

C  NASTK  -  NUMBER  OF  ASP  ATP  TRUCK 

C  NRONTK  -  NUMBER  OF  ROUNDS  ON  SUPPLY  TRUCK 

C  MIXX  -  MIX  INDEX  OF  AWO  ON  SUPPLY  TRUCK 

C  DIST  -  ROAD  DIST  TO  BE  TRAVELED 

C  ITKTYP  ■  TRUCK  TYPE 

C  TRIM  -  ROAD  TRAVEL  TIME 

C  TFAIL  -  TIME  DELAY  DUE  TO  FAILURE 

C  TMIND  -  TIME  DELAY  DUE  TO  INTERDICTION 

C  TQTTIM  -  TIME  TO  SCHEDULE  ATP  OR  ASP  ARRIVAL 

C  TPAR  -  TIME  REQUIRED  TO  SHIFT  A  PARTIAL  LOAD 

C  FRNA  -  FLOATING  POINT  NUMBER  FOR  ROUNDS  AVAILABLE  FOR  THE  PARTIAL 

C  FRNN  -  REAL  VARIABLE  FOR  NUMBER  OF  ROUNDS  NEEDED 

C  NCSAQ  -  CSA  ATP  QUEUE  NUMBER 

C  TLOAD  -  LOAD  TIME 

C 
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DIMENSION  IIP  RAM ( 5 ) 

DO  1  I  -1,5 
IIPRAM(I)  =  0 

1  CONTINUE 

NUMART  =  IATP( IPARM(2) ,9) 

NUMMAN  =  IATP(IPARM(2) , 10) 

NTOTWK* IATP ( I PARM ( 2 ) , 10 )  +  IATP(IPARM(2)  ,9) 

NINC  =  0 

C  QUEUE  THRESHOLD  LOGIC 

C  IF  NEITHER  QUEUE  IS  LONGER  THAN  THRESHOLD  1,  NO  CHANGE (90) 

IF( IATP (I PARM (2) ,14)  .LT.  IATPSD(2)  .AND.  IATP(IPARM(2) ,15) 

Z  .LT.  IATPSD(4) )G0  TO  90 

C  IF  NOT  ABOVE  THRESHOLD  2  AND  OTHER  GT  0  NO  CHANGE (90) 

IF( IATP ( IPARM ( 2 ) ,14)  .LT.  IATPSD(3)  .AND.  IATP ( I PARM( 2 ) , 15) 

Z  .GT.  0)GO  TO  2 
C  NEED  TO  CHANGE(5) 

GO  TO  5 

2  IF( IATP( IPARM ( 2 ) ,15)  .LT.  IATPSD(5)  .AND.  IATP(IPARM(2),14) 

Z  .GT.  0)G0  TO  90 

C  MAKE  ADJUSTMENT. IF  ARTY  QUEUE  EMPTY  MOVE  SERVERS  TO  MANEUVER 

5  IF( IATP( IPARM (2), 14)  .GT.  0)G0  TO  10 
NUMMAN  =  NUMMAN  +NUMART 
WRITE(LU0UT,6)  NUMART, NUMMAN 

6  F0RMAT(I6,"  ARTY  SERVERS  HAVE  MOVED  TO  HELP  ",14,"  MANVR  SERVERS") 
GO  TO  30 

10  IF(IATP(IPARM(2) ,15)  .GT.  0)G0  TO  20 
C  MANEUVER  QUEUE  EMPTY  SHIFT  SERVERS 
NUMART  =  NUMART  +  NUMMAN 
WRITE (LUOUT, 15)  NUMMAN, NUMART 

15  F0RMAT(I6,"  MNVR  SERVER  HAVE  MOVED  TO  HELP  ",I4,"  ARTY  SERVERS") 

C  IF  ARTY  GT  THRESHOLD  2  WAKE  UP  SERVERS 

20  IF ( IATP ( I PARM (2)  ,14)  .LT.  IATPSD(3))G0  TO  30 

N INC= IATP ( IPARM ( 2 ) , 9 ) *( I ATPSD ( 1 ) -NTOTWK ) / ( l+NTOTWK )+l 
NUMART=NUMART  +  NINC 
WRITE(LU0UT,25)  NUMART 

25  FORMAT ("  DUE  TO  THRESHOLD  2  ON  ARTY,", 14,"  SERVERS  ARE  NOW  AWAKE") 
GO  TO  90 

30  IF ( IATP ( I PARM (2 ) ,15)  .LT.  IATPSD(5))G0  TO  90 

KINC*IATP( IPARM(2) , 10) *( IATPSD(l)-NTOTWK)/( 1  +  NTOTWK)  +  1 
NUMMAN  -  NUMMAN  +  KINC 
WRITE(LU0UT,35)  NUMMAN 

35  FORMAT ("  DUE  TO  THRESHOLD  2  ON  MNVR,", 14,"  SERVERS  ARE  NOW  AWAKE") 
I F ( N I NC  .GT.  0)KINC  =  IATPSO(l)  -  (NUMMAN  +  NUMART) 

NUMMAN  *  KINC  +  NUMMAN 
C  DETERMINE  QUEUE  NUMBER  NUMQ 

90  NUMQ5*  IQ  ( I  PARM  ( 1 )  +3 , 1  PARM  ( 2 ) ) 

C  REMOVE  TRUCK  FROM  QUEUE 

CALL  GETQUE ( NUMTK, NUMQ ) 

C****  CHECK  FOR  FALSE  EVENT,  NUMTK=0 
IF(NUMTK.GT.O)  GO  TO  95 

C****  HAVE  FLASE  EVENT  SCHEDULE  NEXT  FALSE  EVENT 
T0TIM-TIME+10. 
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r>  <->  o  o  o  o 


CALL  SCHED ( 6 , IPARM , TOT IM ) 

RETURN 

95  CONTINUE 

C  FIND  AMMO  MIX  INDEX  OF  TRUCK  MIX 
MIX  =  ITRUCK  (NLMTK  ,5 ) 

C  FIND  AMMO  TYPE  WANTED.  ASSUME  ONLY  ONE  TYPE 
JLOOP  =  LPPAR(2) 

DO  100  I  3  1 .JLOOP 
IF( IMIX (MIX,  I)  .GT.  0)GO  TO  120 
100  CONTINUE 

C  IF  EXIT  HERE  NO  AMMO  IN  THIS  MIX. 

WRITE(LUOUT, 105 )MIX 

105  FORMAT ("  MIX  M5,"  CONTAINS  NO  TYPES  OF  AMMO  -  ATP  ") 

RETURN 

C  RECORD  NUMBER  OF  ROUNDS  NEEDED  -  NRNDSN  AND  TYPE  OF  ROUNDS 
120  NRNDSN  3  IMIX(MIX.I) 

IRNTYP  =  I 

C  NOW  TO  LOCATE  TRUCK  CONTAINING  PROPER  TYPE  OF  AMMO 
C  FIRST  CHECK  ASP  TRUCKS.  PASS  AMMO  AND  QUEUE  TO  CHECK. 

NASPQ  3  IQ( 3 , IPARM ( 2 ) ) 

130  CALL  FINTK(NASPQ, IRNTYP, NASTK) 

C  IF  NO  TRUCK,  GO  TO  140 

IF (NASTK  .EQ.  0)G0  TO  140 

FIND  THE  NUMBER  OF  ROUNDS  ON  NASTK.  IF  SUFFICIENT,  DECREMENT 
AMMO,  SCHEDULE  UNTARV,  PUT  TRUCK  BACK  IN  ASP  Q. 

IF  INSUFFICIENT  EMPTY  ASP  TRUCK,  SENT  TO  ASP,  DECREMENT 
THE  NUMBER  OF  ROUNDS  REQUIRED,  FIND  ANOTHER  TRUCK  WITH 
THE  PROPER  AMMO 

UPDATE  PER  CENT  POUNOS  ON  THE  TRUCK 
MIXX  3  ITRUCK(NASTK,5 ) 

NRONTK  =  (IMIX(MIXX, IRNTYP)  *  ITRUCK(NASTK,6)  +  99)  /  100 
WRITE(LUOUT, 300)MIX, MIXX, IRNTYP, NRONTK, NRNDSN ,NUMTK, NASTK, NASPQ 
300  FORMAT ("  IATP  \8I6) 

C  IF  INSUFFICIENT  ROUNDS  GO  TO  150 
I F( NRNDSN  .GT.  NRONTK)GO  TO  150 
C  SUFFICIENT  AMMO  ON  TRUCK.  DECREMENT  AMMO  ON  TRUCK. 

C  IF  ARTY  AMMO  GO  LOAD  POWDER  TRUCK 
NRND  =  IMIX(MIX, IRNTYP) 

IF( IRNTYP  .GT.  LPPAR(3)  )CALL  LDPVJDR (NRND,  IPARM) 

ITRUCK(NASTK,6)  3  100  *  (NRONTK  -  NRNDSN)  /  IMIX(MIXX, IRNTYP) 

C  PUT  TRUCK  BACK  IN  QUEUE 

C****  IF  TRUCK  IS  EXACTLY  EMPTY  DO  NOT  PUT  INTO  QUEUE 
IF( ITRUCK(NASTK,6)  .EQ.  0)G0  TO  150 
CALL  PUTQUE(NASTK, NASPQ) 

C  GO  TO  SCHEDULE  UNTARV 

GO  TO  200 

****  INSUFFICIENT  AMMO  OR  EXACTLY  ENOUGH  AMMO  ON  S  AND  P 
C  TIME  TO  SHIFT  PARTIAL  LOAD 

150  FRNN  -  NRNDSN 
FRNA  3  NRONTK 

TPAR  3  IMI X (M IX , 22 )  *  FRNA  /  FRNN 
IF  (IDAY  .EQ.  0)  TPAR  3  1.54*TPAR 
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NRNDSN  =  NRNDSN  -  MRONTK 
ITRUCK(NASTK,6)  *  0 
C  SCHEDULE  ASPAR1  FOR  NASTK 
C  DETERMINE  DIST  TO  BE  TRAVELED 
DIST  =  IATP ( IPARM ( 2 ) ,2) 

IF(NASPQ  .EQ.  IQ(2, IPARM (2)))DIST  3  IATP(IPARM(2),1) 

ITKTYP  =  ITRUCK(NASTK.l) 

TRIM  =  60  *  DIST  /  ITYPE ( ITKTYP, IDAY+3) 

ITRUCK(NASTK,3)  =  4 

C  COMPUTE  DELAY  DUE  TO  FAILURE  -  TFAIL 
CALL  OPERA( NASTK, TRTM, TFAIL) 

C  INTERDICTION  DELAY  -  TMIND 

CALL  INTRDK(NASTK, TMIND) 

TOTTIM  =  TRTM  +  TIME  +  TFAIL  +  TMIND  +  TPAR 
IIPRAM(l)  =  IPARM(2) 

IIPRAM(2)  =  NASTK 
I IPRAM (3 )  =  IATP(IPARM(2),6) 

C  ASSUME  ASP-ATP  TRUCK 

I PROG =12 

C  IF  NASPQ  THE  CSA-ASP  QUEUE  THEN  CHANGE  CALL 
IF{NASPQ  .NE.  IQ(2,IPARM(2)))G0  TO  143 
I PROG  =  9 
I  IPRAM  (3)  =  1 

143  CALL  SCHED(IPROG,IIPRAM, TOTTIM) 

C****  if  EXACTLY  ENOUGH  ROUNDS  ON  TRUCK, SEND  TRUCK  BACK  TO  UNIT 
IF (NRNDSN. EQ.O)  GO  TO  200 

C  GO  GET  ANOTHER  ASP-ATP  TRUCK  TO  COMPLETE  THE  LOAD 
GO  TO  130 

C  NA  ASP-ATP  TRUCK  SO  TRY  CAS  ATP  TRUCK 

C****  IF  HAVE  LOOKED  AT  CSA  QUEUE,  THERE  IS  NO  AMMO  GO  TO  142,  TRUCK  LOS 

140  IF(NASPQ.EQ. IQ ( 2 , IPARM ( 2 ) ) )  GO  TO  142 
NASPQ=IQ(2, IPARM(2) ) 

GO  TO  130 
C****  WRITE  FLAG 

142  WRITE (2 ,142)  IPARM (2 ) .IRNTYP, TIME 

141  FORMAT ("  ATP  NUMB  ",I2,"  IS  OUT  OF  AMMO  ",14,"  AT  TIME  \F8.2) 
RETURN 

C  HAVE  SUFFICIENT  AMMO,  SCHEDULE  UNTARV  AND  NEXT  ATP  DECREMENT 
200  IATP (IPARM (2) , IPARM ( 1 ) +13 )  =  IATP(IPARM(2) ,IPARM(1)+13)  -  1 
C  DECREMENT  AMMO 

IATP (IPARM (2 ),IRNTYP*3+13)  =  IATP(IPARM(2),IRNTYP*3+13) 

Z  -  IM IX (MIX, IRNTYP) 

IATP ( IP ARM ( 2 ) , IRNTYP*3+14) = IATP ( I PARM ( 2 ) , IRNTYP*3+1 4 )  - 
Z  IMIX(MIX, IRNTYP) 

NFKLF  =  NUMART 

IF(IPARM(1)  .EQ.  2) NFKLF  =  NUMMAN 
TLOAD* IMI X (MIX , 22 ) /NFKLF 
IF  (IDAY.EQ.O)  TLOAD  *  1.54*TL0AD 
TOTTIM  ■  TIME  +  TLOAD 

IF ( IATP ( I PARM ( 2 ) , IPARM ( 1 )+l 3 )  .GE.  1)CALL  SCHED(6,IPARM,T0TTIM) 
C****  IF  QUEUE  IS  EMPTY  SCHEDULE  FALSE  EVENT 
T0TIM-T0TTIM+5. 


I F ( I ATP ( IPARM(2) , IPARM( 1)+13) .EQ.O)  CALL  SCHED(6,IPARM,TOTIM) 

C  SCHEDULE  UNTARV 

ITRUCK(NUMTK,3 )  =  4 
CALL  INTRDK(NUMTK, TMIND ) 

C  IF  MO  INTERDICTION,  BYPASS 

IF ( TM IND  .LE.  0)G0  TO  ISO 
C  DECREMENT  AMMO 

NASP  =  IATP( IPARM(2) ,6) 

IASPAM(NASP.IRNTYP)  =  IASP AM ( NASP , IRNTYP )  +  IMIX(MIX, IRNTYP) 
IASP(NASP , IRNTYP+13 )  =  IASP(NASP, IRNTYP+13)  -  IMIX(MIX, IRNTYP) 
TMIND  =  TMIND  +  IMIX(MIX,23) 

160  CONTINUE 

IPARM(l)  *  ITRUCK(NUMTK,4) 

IPARM(2)  =  NUMTK 
DIST  =  IUNIT( IPARM(l) ,4) 

ITKTYP  =  ITRUCK(NUMTK,1) 

TRIM  =  60  *  DIST  /  ITYPE( ITKTYP, IDAY+1) 

CALL  OPERA (NUMTK, TRIM, TFAIL) 

TLOAD  =  IM IX (MIX, 22) 

IF  (IDAY  .EQ.  0)  TLOAD  =  1.54*TL0AD 
TOTTIM  =  TIME  +  TRIM  +  TFAIL  +  TMIND  +  TLOAD 
CALL  SCHED(8,IPARM,T0TTIM) 

ITRUCK( IPARM(2) ,6)  =  100 

RETURN 

ENO 
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i.  SUBROUTINE:  ATPARV 

PURPOSE:  Processes  the  arrival  of  the  unit  truck  at  the  Amnunition 
Transfer  Point  (ATP). 

CO  WON  BLOCKS:  LOG 

CALLS:  PUTQUE 
SCHED 

IS  CALLED  BY:  ARM  Driver 

CALLING  PARAMETERS:  IPARM  (5)  -  (1)  —  Unit  Number 

(2)  --  Truck  Number 

(3)  --  ATP  Number 

LOCAL  ARRAYS:  None. 

FUNCTIONS: 

Determine  ammunition  needed  by  the  unit  truck. 

If  ammunition  is  not  available  at  the  ATP  send  truck  to  the 
ASP(ASPARV) . 

If  ammunition  is  available  at  the  ATP  place  truck  in  the  ATP  queue. 
If  first  truck  in  the  ATP  queue,  schedule  an  ATP  event. 
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SUBROUTINE  ATPARV  (IP ARM) 

C****  EVENT  ATPARV  --  ARRIVAL  OF  UNIT  TRUCK  AT  ATP 
C 

C****  J.  FOX  JAN  79 
C 

C****  IPARM(l)  —  UNIT  NUMBER 
C****  IPARM(2)  —  TRUCK  NUMBER 
C****  IPARM(3)  —  ATP  NUMBER 
C 

C****  SCHEDULES  —  ASPARV,  ARRIVAL  OF  UNIT  TRUCK  AT  ASP 
C  ( IF  AMMO  IS  NOT  CURRENTLY  ON  HAND  FOR  ALL 

C  TRUCKS  IN  QUEUE) 

C  -ATP, SERVICE  OF  UNIT  TRUCK  FROM  QUEUE  AT  ATP 

C  (IF  ATP  SERVICE  WAS  IDLE  FOR  THIS  QUEUE) 

C 

C****  DATA  REQUIRED  —  AMMO  REQUIRED  BY  TRUCKS  IN  QUEUE. 

C 

COMMON  /LOG/  IATP(4,30),  IASP(4,41),  IUN IT(75 ,69) , 

Z  ITRUCK( 560,7),  ITYPE{6,6),  IMIX(40,23),  INTER (9), 

Z  IRSTME(20,3) ,  IATPSD(5),  IDAY,  TIME, 

$  ICSA(20),  LPPAR(5) ,  IASPAM(4,20) ,  LUOUT,  TCIST,  TCILNG,  L00K(17) 
DIMENSION  IPARM (5 ) 

C  LOCAL  VARIABLES  DEFINED 

C  JLOOP  -  TOP  OF  DO  LOOP  FROM  COMMON  LPPAR 
C  NUMQ  -  ATP  qUEUE  FOR  ARTY  OR  ROUTINE  SERVICE 

C  MIX  -  INDEX  OF  AMMO  MIX  USED  TOACCESS  IMIX. 

C  NEEDTK  -  NUMBER  OF  ROUNDS  NEEDED  TYPE  I  BY  UNIT  TRUCK. 

C  INDEX  -  INDEX  COMPUTED  FOR  AMMO  TYPE  I  TO  ACCESS 
C  ONHAND  AND  WANTED  BY  TRUCK  IN  QUEUE. 

C  J  ONHAND  -  AMOUNT  OF  AWO  TYPE  I  PRESENTLY  ON  HAND  AT  ATP 
C  NEEDOT  -  AMOUNT  OF  AMMO  I  NEEDED  BY  OTHER  TRUCKS  IN  QUEUE. 

C  MANART  -  FLAG  SET  TO  2  IF  MANEUVER  AMMO,  1  IF  ARTY  AMMO 

C  DIST  -  DIST  FROM  ASP  TO  ATP. 

C  RATE  -  TRUCK  MOVEMENT  SPEED 

C  ITKIYP  -  TRUCK  TYPE  FROM  I TRUCK. 

C  TRIM  -  UNOPPOSED  TRAVEL  TIME. 

C  TFAIL  -  TRAVEL  TIME  INCREMENT  DUE  TO  MECHANICAL  FAILURE 

C  TMIND  -  TRAVEL  TIME  INCREMENT  DUE  TO  INTERDICTION 

C  TOLRDS  -  TOTAL  RDS  NEEDED  BY  ALL  ARTY  TRKS 

C  TOTTIM  -  TIME  OF  TRUCK  ARRIVAL  AT  ASP 

C  DETERMINE  AMMO  MIX  WANTED  BY  THE  TRUCK. 

MIX  »  ITRUCK(IPARM(2),5) 

IF(MIX.GT.O)  GO  TO  1 
WRITE(2 ,2)  IPARM(2) 

2  FORMAT("  ATPARV  —  ZERO  MIX  ON  TRUCK  ",  14) 

RETURN 
1  CONTINUE 

C  SINCE  AT  ATP  CHECK  FOR  ATP  AMMO  I  THRU  LPPAR(2) 

JLOOP  -  LPPAR(2 ) 

DO  5  I  -  1, JLOOP 

C  IF  NO  AMMO  I  IN  MIX  GO  TO  5. 

IF(IMIX, I)  .EQ.  0)G0  TO  5 


C  AMMO  I  IS  NEEDED  HOW  MUCH 
NEEDTK  =  IM I X (M IX , I) 

C  ASSUME  MANEUVER  AMMO. 

MANART  =  2 

C  IF  ARTY  RESET  MANART 

IF ( I  .ST.  LFPAR(3))MANART  =  1 

C  HOW  MANY  ROUNDS  ARE  NEEDED  BY  THE  OTHER  TRUCKS  IN  THE  QUEUE 
INDEX  =15+3*1-1 
NEEDOT  =  IATP ( IPARM ( 3 ) , INDEX ) 

C  HOW  MANY  ROUNDS  I  ARE  AT  ATP  -  JONHND 
JONHND  =  IATP (IPARM (3), INDEX  -  1) 

C  IF  INSUFFICIENT  ON  HAND  GO  TO  4 

IF( JONHND  .LT.  NEEDOT  +  NEEDTK) GO  TO  4 
C  IF  NOT  ARTY  GO  TO  5 

IF(MANART  .EQ.  2)G0  TO  5 
C  HAVE  ARTY  IS  THERE  SUFFICIENT  POWDER 
C  HOW  MANY  RDS  ARE  NEEDED  BY  ALL  ARTY  TRKS  IN  QUEUE 
TOLRDS  =  IATP( IPARM(3) ,26)  +  IATP ( IPARM ( 3 ) , 29 ) 

IF( IATP (IPARM (3) ,22)  ,GE.  TOLRDS  +  NEEDTK )GO  TO  5 
C  INSUFFICIENT  AMMO  SEND  TO  ASP 

C  FIND  DIST  TO  ASP 

4  DIST  =  IATP(IPARM(3) ,2) 

C  FIND  TRUCK  RATE  OF  MOVEMENT  -  RATE 
ITKTYP  =  ITRUCK( IPARM(2) ,1) 

RATE  =  I TYPE (ITKTYP, IDA Y+3) 

TRTM  =  DIST  /  RATE  *  60. 

C  CHANGE  TRUCK  STATUS  CODE 

ITRUCK(IPARM(2) ,3)  =  5 
C  COMPUTE  DELAY  DUE  TO  FAILURE  -  TFAIL 
CALL  OPERA (IPARM (2), TRTM .TFAIL) 

C  COMPUTE  INTERDICTION  DELAY  -  TMIND 

CALL  INTRDK( IPARM (2), TMIND) 

C  ICOMPUTE  ASP  ARRIVAL  TIME  -  TOTTIM 
TOTTIM  =  TIME  +TRTM  +  TFAIL  +  TMIND 
IPARM(3)  =  IUN IT ( IPARM ( 1 ) ,3) 

CALL  SCHED(5, IPARM.TOTTIM) 

GO  TO  25 

5  CONTINUE 

C  HAVE  AMMO  ON  HAND 

C  FIND  QUEUE  NUMBER  -  NUMQ 

NUMQ  =  IATP (IPARM (3), MANART  +  10) 

CALL  PUTQUE( IPARM (2), NUMQ) 

ITRUCK  (IPARM(2),  3)  *  2 
C  ADD  TO  QUEUE  DEMAND  FOR  AMMO  TYPE 
JLOOP  «  LPPAR(2) 

DO  10  I  =  1, JLOOP 
INDEX  =  15+  3*1  -  1 

IATP(IPARM(3), INDEX)  «  IATP(IPARM(3) , INDEX)  +  IMIX(MIX.I) 
C****  IF  ARTY  ADO  TO  POWDER  ,  IF  NOT  GO  TO  10 
IF (MANART. EQ. 2)  GO  TO  10 

IATP( IPARM( 3 ) , 23 )■ IATP ( IPARM (3 ) ,23)+IMIX(MIX, I ) 

10  CONTINUE 
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C  INCREMENT  NUMBER  OF  TRUCKS  IN  THE  QUEUE 

IATP ( I PARM ( 3 ) .MANART  +13)  =  IATP ( I P ARM ( 3 ) .MANART+13)  +  1 
C****  IF  QUEUE  HAS  NOT  BEEN  USED  SCHEDULE  ATP  NOW 
IFLAG=8 

IF(MANART.NE.l)  IFLAG=13 

IF ( IATP ( IP ARM ( 3 ) , IFLAG ) .EQ.l)  GO  TO  25 

IATP ( I PARM  (3 ) ,IFLAG)al 

IP ARM ( 1 )  =  MANART 

IPARM(2)  »  IPARM(3) 

CALL  SCHED(6 ,IPARM,TIME) 

25  CONTINUE 
RETURN 
END 
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j.  SUBROUTINE:  ATPAR1 

PURPOSE:  Process  the  arrival  of  a  CSA-ATP  truck  at  the  ATP. 

COMMON  BLOCKS:  LOG 

CALLS :  IQ 

PUTQUE 

IS  CALLED  BY:  ARM  Driver 

CALLING  PARAMETERS:  IPARM  (5)  -  (1)  —  ATP  Number 

(2)  —  Truck  Number 

LOCAL  ARRAYS:  None. 

FUNCTIONS: 

Determine  the  ammunition  carried  on  the  truck. 

Update  the  ammunition  available  and  place  the  truck  in  the  CSA-ATP 
queue. 
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k.  SUBROUTINE:  ATPAR2 

PURPOSE:  Processes  the  arrival  of  an  ASP-ATP  truck  at  the  Ammunition 
Transfer  Point  (ATP). 

COMMON  BLOCKS:  LOG 

CALLS:  IQ 

PUTQUE 

IS  CALLED  BY:  ARM  Driver 

CALLING  PARAMETERS:  IPARM  (5)  -  (1)  —  ATP  Number 

(2)  --  Truck  Number 

LOCAL  ARRAYS:  None. 

FUNCTIONS: 

Determines  the  ammunition  mix  on  the  truck. 

Updates  the  IATP  for  ammunition  available. 

Places  truck  in  ASP-ATp  queue. 
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1.  SUBROUTINE:  CONTROL 

PURPOSE:  Enables  interactive  control  to  check  or  edit  the  data  files, 
schedule  control  events,  schedule  a  stop  simulation  event,  create  events, 
list  or  modify  the  truck  assignments,  and  return  to  regular  processing. 

COMMON  BLOCKS:  LOG 

CALLS:  CREEVT 
EDIT 
REPORT 
SCHED 
TRKPUT 

IS  CALLED  BY:  ARM  Driver 

CALLING  PARAMETERS:  TIME  —  Present  model  battle  time. 

LOCAL  ARRAYS:  IIPARM(5)  —  Used  to  schedule  other  events. 

FUNCTIONS: 

Provides  menu  of  possible  functions  and  requests  operator's  input. 
Reads  operator's  input  and  verifies  input  to  be  in  the  valid  range. 
Branches  to  perform  operator's  requested  function. 

Returns  to  the  first  function. 
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m.  SUBROUTINE:  CSAARV 

PURPOSE:  To  receive  and  process  a  CSA-ASP  or  CSA-ATP  truck  at  the  Corps 


Supply  Activity  (CSA). 

COMMON  BLOCKS:  LOG 

CALLS:  INTROK 
OPERA 
SCHED 

IS  CALLED  BY:  ARM  Driver 
CALLING  PARAMETERS:  IPARM  (5)  -  (1) 

CSA-ASP  Truck 
LOCAL  ARRAYS:  None. 

FUNCTIONS: 


—  ATP  Number  or  ASP  Number 

(2)  —  Truck  Number 

(3)  —  1  if  CSA-ATP  Truck,  2  if 


Determines  anmunition  mix  need  on  the  truck. 

Update  ICSA  for  the  number  of  rounds  taken  from  the  CSA. 

Schedule  truck  returning  to  ASP  or  ATP  with  delays  for  truck 
failure  or  interdiction  as  appropriate. 
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SUBROUTINE  CSAARV  (IPARM) 

C****  EVENT  CSAARV  —  ARRIVAL  OF  TRUCK  AT  CSA 
C 

C****  J .  FOX  JAN  79 
C 

C****  IPARM(l)  —  ATP  NUMBER  OF  ASP  NUMBER 
C****  IPARM(2 )  —  TRUCK  NUMBER 
C****  IPARM(3)  —  1  IF  ATP,  2  IF  ASP 
C 

C****  SCHEDULES  —  ATPAR1 ,  ARRIVAL  OF  TRUCK  AT  ATP 
C 

C****  CHANGES  —  CSA  AWIO  SUPPLY. 

C 

COMMON  /LOG/  IATP(4,30),  IASP(4,41),  IUNIT(75,69) , 

Z  ITRUCK(560,7) ,  ITYPE(6,6),  IMIX(40,23),  INTER(9), 

Z  IRSTME(20,3),  IATPSD(5),  IDAY,  TIME, 

$  ICSA(20),  LPPAR(5) ,  IASPAM(4,20) ,  LUOUT,  TCIST,  TCILNG,  LOOK(17) 

DIMENSION  IPARM ( 5 ) 

C 

C****  LOCAL  VARIABLES  : 

C****  MIX  —  AMMO  MIX  NUMBER  ON  TRUCK 

C****  LDTIM  —  TIME  TO  LOAD  TRUCK 

C****  DIST  —  DIST  BACK  TO  ASP  OR  ATP 

C****  JLOOP  -  TOP  OF  LOOP  FROM  LPPAR 

C****  TRTM  —  TRAVEL  TIME 

C****  ITKTYP  —  TRUCK  TYPE 

C****  TRKSP  —  TRUCK  SPEED 

C****  TFAIL  —  DELAY  ENROUTE  DUE  TO  FAILURE 

C****  TOTTIM  —  TIME  OF  ARRIVAL  OF  TRUCK  BACK  TO  ATP 

C****  TMIND  —  INTERDICTION  TIME  DELAY 

C 

C****  FIND  AMMO  MIX  TO  BE  LOADED  ON  TRUCK 
MIX  =  ITRUCK(IPARM(2) ,  5) 

C 

C****  USE  DO  LOOP  TO  PROCESS  EACH  AMMO  TO  ADD  TO  ICSA 
C****  THE  AMOUNT  LOADED. 

JLOOP  =  LPPAR(l) 

DO  5  1=  1, JLOOP 

ICSA ( I )  *  ICSA ( I )  +  IMIXCMIX,  I) 

5  CONTINUE 
C 

C****  FIND  LOAD  TIME  FOR  MIX 
LDTIM  *  IMIXCMIX,  21) 

C 

C****  DETERMINE  TIME  TO  RETURN  TO  ASP  OR  ATP 
C****  (DIST,  IF  ATP  DIST  IS  IN  IATP) 

IF ( IPARM(3 )  .EQ.  2)  GO  TO  10 
C 

C****  ATP  TRUCK 

DIST  »  IATP ( IPARM (1) ,  1) 

GO  TO  15 
C 

C****  ASP  TRUCK  SO  IPARM(l)  IS  ASP  NUMB 
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10  DIST  =  IA$P( IPARM(l) ,  1) 
C 


C****  DETERMINE  TYPE  OF  TRUCK  (ITKTYP) 
15  ITKTYP  =  ITRUCK(IPARM(2) ,  1) 

TRKSP  =  ITYPE ( ITKTYP, IDAY+3) 

C 

C****  CALCULATE  TRAVEL  TIME  (TRTM) 

TRTM  =  DIST  /  TRKSP  *  60. 
ITRUCK(IPARM(2) ,6)  =  100 
ITRUCK( IPARM(2) ,3)  =  4 
C****  COMPOTE  DELAY  DUE  TO  INTERDICTION 
CALL  INTRDK(IPARM(2),  TMINO) 

I F( TM IND  . LE.  0)G0  TO  30 
C****  CHARGE  ADDITIONAL  AMMO  TO  CSA 
JLOOP  =  LPPAR(l) 

DO  35  I  =  1, JLOOP 


ICSA(I)  =  ICSA(I)  +  IMIX(MIX, 
35  CONTINUE 

C****  INCREMENT  DELAY  BY  LOAD  TIME 
TMIND  =  TMIND  +  LDTIM 
30  CONTINUE 


I) 


(TMIND)  AND  FAILURE  (TFAIL) 


CALL  0PERA(IPARM(2),  TRTM,  TFAIL) 

TOTTIM  =  TRTM  +  LDTIM  +  TIME  +  TFAIL  +  TMIND 
C 

C****  SCHEDULE  ATPAR1  (IPARM  IS  ALREADY  OK  FOR  ATPAR1) 
C****  IF  ASP  TRUCK  GO  TO  25 

IF ( IPARM (3 )  .EQ.  2)  GO  TO  25 
CALL  SCHED( 10, IPARM, TOTTIM) 

GO  TO  20 


C 


C****  HERE  WOULD  BE  LOGIC  TO  SCHEDULE  A  CSA  TO  ASP  TRUCK 
25  CONTINUE 
WRITE (2, 100) 

STOP 

C 


20  RETURN 

100  FORMAT("  NO  LOGIC  FOR  CSA  TO  ASP  LINK") 
END 
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n.  SUBROUTINE:  DEMAND 

PURPOSE:  Updates  the  ammunition  required  by  a  unit  because  of  a  demand 
pulse. 

COMMON  BLOCKS:  LOG 

CALLS:  OPERA 
RDIEXO 
SCHED 

IS  CALLED  BY:  ARM  Driver 

CALLING  PARAMETERS:  IPARM  (5)  -  (I)  —  Unit  Number 
LOCAL  ARRAYS:  None. 

FUNCTIONS: 

Calls  RDIEXO  to  update  IUNIT  with  the  latest  demand  pulse. 

If  UNIT  is  a  FARP,  moves  aimiunition  from  the  ground  available  to 
aircraft. 

If  UNIT  is  artillery,  checks  to  see  if  critical  resupply  exists  to 
cause  helicopter  resupply  to  be  initiated. 

Schedules  RELOAD  event  for  the  unit. 


l 
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SUBROUTINE  OEM AND  (IPARM) 

C****  EVENT  DEMAND  -  CHECKS  AMMO  OEM AND  OF  UNITS. 

C 

C****  D.  HILLIS  JAN  79 
C 

C****  IPARM(l)  ~  UNIT  NUMBER 
C 

C****  SCHEDULES  —  RELOAD,  RESUPPLY  OF  UNITS. 

C  HELARV ,  ARRIVAL  OF  HELICOPTER  AT  UNIT 

C  DEMAND,  CHECKS  DEMAND  AGAIN. 

C****  LOCAL  VARIABLE  DEFINITIONS 
C****  K  -  UNIT  AMMO  INDEX 

C****  NFLAG  -  0  RELOAD  NOT  SCHEDULED  YET.  1  RELOAD  ALREADY  SCHEDULED 
C****  I FLAG  -  0  NORMAL  MODE.  1  -  155  HE  OR  I  CM  AMMO  BELOW  CRL 
C****  I  -  UNIT  NUMBER 
C****  IA  -  LOOP  INDEX 
C****  II  -  LOOP  INDEX 

C****  JLOOP  -  TOP  OF  DO  LOOP  FROM  COMMON  LPPAR 
C****  TRIM  -  ROAD  TRAVEL  TIME 

C****  TFAIL  -  TIME  LOST  DUE  TO  REMED IAL  MAINTENANCE 
C****  TOTTIM  -  TIME  TO  SCHEDULE  THE  EVENT 
C****  IRRL  -  ROUTINE  RESUPPLY  LEVEL  FOR  LIVE  WPNS 
C****  IBAM  -  BASIC  AMMO  LEVEL  FOR  LIVE  WPNS 
C****  IRGND  -  NO.  RNDS  ON  GROUND  AT  FARP 
C 

COMMON  /LOG/  IATP(4,30),  IASP(4,41),  IUNIT(75,69), 

Z  ITRUCK(560,7) ,  ITYPE(6,6),  IMIX(40,23),  INTER(9), 

Z  IRSTME(20,3) ,  IATPSD(5),  IDAY,  TIME, 

$  ICSA(20) ,  LPPAR(5) ,  IASPAM(4,20),  LUOUT,  TCIST,  TCILNG,  LOOK(17) 
DIMENSION  IPARM (5 ) 

I  =  IPARM(l) 

C 

CALL  RDIEXO(I) 

C  INITIALIZE  FLAGS  AND  COUNTERS 
I FLAG  =  0 
NFLAG  =  0 

C****  SELECT  AN  AWO  TYPE 
DO  100  KK  =  1,5 
K  =  KK  *  12  -  4 
IF ( IUN IT(I,K). EQ .0 )  GO  TO  100 
IBAM*IUNIT( I ,K+1)*IUNIT( I,K+7 ) 

C****  CHECK  FOR  A  FARP 

IF ( I UN  IT (1,1). EQ - 8 )  GO  TO  50 
IF( IBAM-IUNIT(I,K+4) .EQ.O)  GO  TO  100 
C****  CHECK  FOR  ROUTINE  RESUPPLY 

IRRL*IUNIT(I ,K+1)*IUNIT( I,K+5) 

IF(IUNIT(I,KH).GT.  IRRL)  GO  TO  100 
L  «  IUNIT(I.K) 

C****  CHECK  FOR  155  ARTY  UNIT 

IF ( IUN IT (1,1) . EQ . 4 )  GO  TO  65 
C*+**  IS  THERE  AMMO  OF  THIS  TYPE  ON  TRUCKS 
35  IF ( IUN IT( I , K+8)  .N£.  0)G0  TO  40 
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IF( IFLAG  .EQ.  1)G0  TO  150 
GO  TO  100 

C****  THERE  IS  AMMO  ON  A  TRUCK 
40  IF( IFLAG  .EQ.  1)G0  TO  110 
IF(NFLAG  .EQ.  1)G0  TO  100 

C  SCHEDULE  RELOAD  IMMEDIATELY 
CALL  SCHED (2,1 PARM , TIME ) 

NFLAG  *  1 
GO  TO  100 

C****  DETERMINE  AMMO  REQUIREMENT  AT  FARP 
50  IRGND*IUNIT( I,K+4)-IBAM  +  IUNIT(I,K+3) 

IF(IUNIT(I,K+3) .GT. IRGND}  GO  TO  55 
IRGND*IRGND- IUN IT ( I » K+3 ) 

IUN IT ( I , K+4 ) * I RGND+ I BAM 
I  UN IT( I ,K+3)*0 
IUNIT(I,K+2)  *  0 

WRITE( LUOUT, 210)  IUNIT( I , K+4 ) , IRGND 
210  FORMAT ("  DMD  -  FARP  0/H*  ",15,"  ON  GRND*  ”,  15) 

GO  TO  35 

55  IUNIT( I, K+3)* IUN IT (I, K+3)- IRGND 

IUNIT( I,K+4)=IBAM-IUNIT( I ,K+3) 

WRITE(LU0UT,210)  IUN IT( I, K+4), IRGND 
GO  TO  35 

C****  CHECK  FOR  AMMO  TYPES  4  AND  5 

65  IF(IUNIT(I,K)  .EQ.  4  .OR.  IUNIT(I.K)  .EQ.  5)G0  TO  70 
GO  TO  35 

C****  CHECK  TO  SEE  IF  CURRENT  AMMO  SUPPLY  GT  CRITICAL  RESUF  LEVEL 
70  IF( IUN IT( I ,K+4)  .GT.  IUNIT(I,K+6)*IUNIT(I,K+1) )G0  TO  35 
IFLAG  *  1 
GO  TO  35 

C***+  COMPARE  AVAILABLE  AMMO  AGAINST  CRL 
110  IF(IUNIT(I,K+8)  +  IUNIT( I, K+4)  .GT.  IUNIT( I ,K+6)*IUNIT(I ,K+1) ) 
ZGO  TO  120 

IF (NFLAG  .EQ.  1)G0  TO  150 
CALL  SCHED (2, 1 PARM, TIME) 

NFLAG  *  1 
GO  TO  150 

120  I F( NFLAG  .EQ.  1)G0  TO  130 
CALL  SCHED (2, IP ARM, TIME) 

NFLAG  *  1 
130  IFLAG  *  0 
GO  TO  100 

C****  HELICOPTER  RESUPPLY  LOGIC 

C****  DOES  UNIT  ALREADY  HAVE  MAX  NUMBER  OF  HELICOPTERS  ASSIGNED 
150  I F( IUN IT(I,68)  .EQ.  2)G0  TO  170 
190  IF ( LPPAR( 5 )  .GT.  0)G0  TO  180 
IF ( IUN IT(I,68)  .EQ.  1)G0  TO  160 
WRITE (LUOUT, 155 )TIME 

155  F0RMAT("  AT",F8.2,"  MIN.  NO  HELICOPTERS  AVAILABLE  ") 

C 
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GO  TO  170 

160  WRITE (LUOUT, 165) TIME 

165  FORMAT("  AT  ",F3.2,"  MIN.  HELI  SCHEDULED,  NO  OTHERS  AVAIL.  " ) 

170  IF ( NFLAG  .EQ.  1)S0  TO  200 
I FLAG  =  0 
GO  TO  100 

180  LPPAR (5 )  *  LPPAR(5)  -  1 
c*** 

C  FIND  AVAILABLE  HELI (MI SSI ON  =  5,  STATUS  =  3) 

OLOOP  =  LPPAR(4) 

DO  185  II  =  l.JLOOP 
IF( ITRUCK ( 11,2)  .NE.  5)G0  TO  185 
IF( ITRUCK ( 11,3)  .EQ.  6)G0  TO  185 
IF(ITRUCK(II,3)  .EQ.  3)G0  TO  175 

185  CONTINUE 

WRITE (LUOUT, 186) 

186  FORMATC  CANNOT  FIND  THE  AVAIL  HELICOPTER-DEMAND  ") 

GO  TO  200 

C  HAVE  HELICOPTER  II  UPDATE  STATUS 

175  ITRUCK( 11,3)  =  4 
C  SCHEDULE  ARRIVAL  AT  UNIT 

IPARM(2)  *  II 

C  FIND  TRAVEL  TIME  TRIM 

TRTM  *  60  *  IUN IT ( IPARM(l) ,5)  /  ITYPE(6 , IDAY+1 ) 

CALL  OPERA(II,TRTM,TFAIL) 

MIX=-ITRUCK(II,5) 

TOTTIM  =  TIME  +  TRTM  +  TFAIL  +  IMIX(MIX,23) 

C  INCREMENT  ASP  AMMO  USED 

JLOOP  =  LPPAR(l) 

DO  187  IA  =  l.JLOOP 

IASPAM( IUNIT(1 ,3) , IA)  =  IASPAM ( IUN IT ( 1 ,3),IA)  +  IMIX(MIX.IA) 

187  CONTINUE 

****  IF  HELICOPTER  FAILS  IN  ROUTE  TO  UNIT 
SEND  ANOTHER  HELICOPTER,  IF  AVAILABLE 
SCHED  HELASP 
SET  STARUS  AS  DOWN 
IF (TFAIL  .LE.  0)G0  TO  188 
ITRUCK(II,3)*6 
CALL  SCHED ( 14 .IPARM, TOTTIM) 

GO  TO  190 

188  IUN IT ( I , 68 )  *  IUN IT ( I , 63)  +  1 

CALL  SCHED( 13, IPARM, TOTTIM) 

I  ATP  ( 1 ,4)  «  IATP  ( 1 ,4)  +  1 
IF( IUNIT(I ,68)  .EQ.  2)G0  TO  170 
C****  MIX  25  IS  FOR  THE  CH47  HELICOPTER 

IF( IMIX(25,L)+IUNIT( I,K+4) .GT. IUNIT( I,K+6)*IUNIT(I ,K+1) )G0  TO  170 
GO  TO  190 
100  CONTINUE 
200  RETURN 
END 


o.  SUBROUTINE:  ENDSIM 

PURPOSE:  Writes  out  LOG,  QUENUM,  QUEPNT  to  permanent  file  (FILE1)  to  give 
checkpoint  capability. 

COIWON  BLOCKS :  LOG 

QUENUM 

QUEPNT 

CALLS:  None 

IS  CALLED  BY:  ARM  Driver 

CALLING  PARAMETERS:  IPARM  (51  -  (1)  —  Time  of  Simulation 
LOCAL  ARRAYS:  None. 

FUNCTIONS: 

Writes  COMMONS  to  mass  storage. 

Prints  ending  message. 
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p.  SUBROUTINE:  HASPAR 

PURPOSE:  Process  the  helicopter  arriving  at  the  Ammunition  Supply  Point 
(ASP)  subsequent  to  carrying  amnunition  to  the  unit. 

COMMON  BLOCKS:  LOG 

CALLS:  None. 

IS  CALLED  BY:  ARM  Oriver 

CALLING  PARAMETERS:  IPARM  (5)  -  (1)  —  None. 

(2)  —  Truck  Number. 

LOCAL  ARRAYS:  None. 

FUNCTIONS: 

Increments  the  number  of  helicopters  available  for  a  mission. 
Changes  the  status  code  to— "at  the  ASP." 

Sets  percent  loaded  to  100%  for  future  activities. 
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q.  SUBROUTINE:  HELARV 

PURPOSE:  Processes  the  arrival  of  a  helicopter  load  of  ammunition  at  a 
unit. 

COMMON  SLOCKS:  LOG 

CALLS:  OPERA 
SCHED 

IS  CALLED  BY:  ARM  Driver 

CALLING  PARAMETERS:  IPARM  (5)  -  (1)  —  Unit  Number. 

(2)  —  Truck  Number. 

LOCAL  ARRAYS:  None. 

FUNCTIONS: 

Determines  mix  of  anrnunition  carried  by  the  helicopter 
Increments  ammunition  on  hand  at  the  unit  (IUNIT). 

Computes  travel  time  back  to  the  ASP. 

Schedules  arrival  at  the  ASP  (HASPAR). 
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r.  SUBROUTINE:  RELOAO 


PURPOSE:  Replaces  rounds  expended  at  unit  weapons  from  rounds  on  unit 
trucks  or  on  the  ground. 

COMMON  BLOCKS:  LOG 

CALLS:  FINTK 
INTRDK 
IQ 

SCHED 

MINO 

IS  CALLED  8Y:  ARM  Driver 

CALLING  PARAMETERS:  IPARM  (5)  -  (1)  —  Unit  Number 
LOCAL  ARRAYS:  None. 

FUNCTIONS: 

Determines  the  number  of  rounds  short  at  the  weapons  for  each 
annum' ti on  type. 

Checks  to  see  if  the  unit  has  the  ammunition  available  on  trucks. 

If  annunition  is  available,  sends  trucks  to  weapons  to  reload. 

If  no  annunition  is  available  on  the  trucks,  program  checks  the 
next  annunition  type. 

If  a  truck  is  emptied,  the  program  schedules  a  unit  departure 
subsequent  to  unloading. 

Time  lost  for  truck  failure  and  interdiction  losses  is  considered. 

If  a  truck  is  only  partially  emptied,  the  program  schedules  a  unit 
arrival  subsequent  to  reloading. 
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SUBROUTINE  RELOAD  ( IPARM) 

C****  EVENT  RELOAD  —  REPUCES  ROUNDS  OF  AMMO  AT  UNIT  WEAPONS. 

C 

C****  D.  HILL  IS  JAN  79 
C 

C****  IPARM ( 1 )  —  UNIT  NUMBER 
C 

C  EVENTS  SCHEDULED  —  UNTOEP,  DEPARTURE  OF  UNIT  TRUCKS 

C  UNTARV,  ARRIVAL  OF  TRUCKS  AT  UNIT. 

C 

C  RELOAD  WILL  OCCUR  AT  THE  TASK  FORCE  LEVEL  FOR  MANEUVER  UNITS, 

C  BATTERY  LEVEL  FOR  ARTILLERY  UNITS  AND  ADA  UNITS,  AND  AT 

C  BATTALION  FARRP'S.  THE  RELOAD  WILL  BE  CALLED  FROM  THE  DEMAND 
C  EVENT. 

C 

C 

C  AMMO  WILL  BE  CONSOLIDATED  ON  TRUCKS  AT  UNIT.  NO  MORE  THAN  1  TRUCK 

C  PER  UNIT  (PER  TYPE  OF  AMMO)  WILL  BE  AT  LESS  THAN  FULL  LOAD  WHILE 

C  LOCATED  AT  THE  UNIT.  A  "SMALL  LOAD"  THRESHOLD  MAY  BE  DEFINED  BELOW 

C  WHICH  AMMO  IS  DUMPED  TO  GROUND  TO  ALLOW  TRUCK  TO  RETURN  TO  ATP. 

C 

C****  LOCAL  VARIABLE  DEFINITION 

C****  K  -  UNIT  AMMO  INDEX 

C****  I  -  UNIT  NUMBER 

C**+*  TOTTIM  -  TIME  OF  SCHEDULED  EVENT 

C****  DEUY  -  TIME  OF  RELOAD  WEAPONS  AT  THE  UNIT 

C****  LOAD  -  NUMBER  OF  ROUNDS  ON  THE  TRUCK 

C****  ND  -  AMMO  DEMAND 

C****  IT  .  TRijCK  NUMBER 

C****  NEWLD  -  TRUCK  LOAD  ON  AMMO  DEMAND 

C****  II  -  QUEUE  NUMBER  OF  UNIT 

C****  MX  -  AMMO  MIX  INDEX 

C****  L  -  AMMO  TYPE 

C****  KIND  -  EVENT  TYPE 

C****  TMIND  -  DELAY  TIME  DUE  TO  INTERDICTION 

C****  NRPW  -  NUMBER  OF  ROUNDS  PER  WEAPON 

C****  NW  -  NUMBER  OF  WEAPONS  LOADED  PER  TRUCK 

C****  NNW  -  NUMBER  OF  WEAPONS  LOADED  PER  TRUCK  TO  HANDLE  TYPE  8 

C****  ICRL  -  FARP  CRITICAL  RESUPPLY  LEVEL 

C****  IBAM  -  BASIC  AMMO  LEVEL  OF  LIVE  WPNS 

C****  IRGNO  -  NO.  OF  ROUNDS  ON  GROUND  AT  FARP 

C****  IFUG  -  0  -FARP  TRUCK  AVAIL.,  I  -NO  FARP  TRUCK  AVAIL. 

COMMON  /LOG/  IATP(4,30),  IASP (4,41) ,  IUNIT(75 ,69 ) , 

Z  ITRUCK( 560,7),  ITYPE{6,6),  IMIX(40,23),  INTER (9 ) , 

Z  IRSTME ( 20 , 3 ) ,  IATPSD(5),  IDAY,  TIME, 

$  ICSA(20) ,  LPPAR (5 ) ,  IASPAM(4 ,20) ,  LUOUT,  TCIST,  TCILNG,  L00K(17) 
DIMENSION  I PARM ( 5 ) 

C 

I  »  IPARM ( 1 ) 

II  -  IQ(l.I) 

C****  SELECT  AN  AMMO  TYPE 
DO  100  KK-1,5 
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IFLAG=0 

K- 12  *  KK  -  4 

L  =  IUNIT(I.K) 

IF(L.EQ.O)  GO  TO  100 

C****  IS  THERE  AMMO  AVAILABLE  ON  THE  TRUCKS 
IF(IUNIT(I,K+8)  .EQ.  0)G0  TO  100 
C****  CALCULATE  AMMO  DEMAND 

10  ND  =  IUNIT(I,K+7)  *  IUNIT(I,K+1)  -  IUNIT(I,K+4) 

I F( IUN IT (1,1) .EQ.8)  ND* IUNIT( I , K+3) 

WRITE(LU0UT,2OO)L,ND 

200  FORMAT("  RELOAD  AFTER  IQ", 215) 

IF ( IUN IT( I , 1) . EQ.3)  GO  TO  60 

I F( ND  .LE.  0 )G0  TO  100 
C****  PULL  truck  FROM  QUEUE 
20  CALL  FINTK(II.L.IT) 

WRITE (LUOUT, 201 ) IT 

201  FORMATC  RELOAD  AFTER  FINTK  ",I5) 

I F( IUN IT( I , 1) .EQ.8 .AND. IT.EQ.O)  GO  TO  62 
IF ( I  UN  IT (1,1) .EQ.8)  GO  TO  30 
IF( IT  .EQ.  0)G0  TO  100 
C****  CHECK  FOR  INTERDICTION 
CALL  INTRDK(IT,TMIND) 

IF(TMIND  .EQ.  0)G0  TO  30 
TOTTIM  =  TIME  +  TMIND 
IPARM(2 )  =  IT 
IPARM ( 3 ) ” IUN IT( I , 3 ) 

C****  SCHEDULE  ASPARV  FOR  EMPTY  TRUCK 
CALL  SCHED( 5, IPARM, TOTTIM) 

MX*ITRUCK(IT,5) 

C****  DECREMENT  UNIT  AWO  ON  TRUCKS 

IUNIT( I,K+8)  -  IUNIT(I,K+8)  -  (IMIX(MX.L)  *  ITRUCK( IT, 6 )+99)/ 100 
C****  THIS  LOGIC  IS  HERE  TO  SOLVE  THE  PROBLEM  OF  WEAPON 
C****  SYSTEMS  HAVING  DIFFERENT  BASIC  LOADS  FOR  THE  SAME  AMMO 
I F ( IUN IT( I ,1) - NE . 1  .AND.  IUNIT(I.l) .NE.2)  GO  TO  20 
IF(IUNIT(I,K).NE.2)  GO  TO  20 
DO  2  <JJ*8,56 ,12 
IF(K.EQ.JJ)  GO  TO  2 

I F( IUN IT ( I ,K) . EQ . IUN IT(I,JJ))  GO  TO  52 
2  CONTINUE 

C  NO  EQUAL  AMMO  FOUND  FOR  2  IN  THIS  UNIT  GO  TO  20 
GO  TO  20 
C 

52  IUNIT(I, JJ+8)*IUNIT(I, JJ+8)-(IMIX(MX,L)*ITRUCK( IT, 6) +99)/ 100 
GO  TO  20 

C****  DETERMINE  CRITICAL  RESUPPLY  AT  FARP 
60  ICRL  *  I UN IT ( I , K+l )  *  IUNIT(I,K+6) 

ISAM* I UNIT( I , K+l ) *IUN IT( I , K+7 ) 

WRITE(LUOUT, 203)  ICRL, IBAM, IUNIT( I,K+4) 

203  F0RMAT("  CRL*  ",I5,"  BAM*  ",I5,"  CURRENT*  ",I5) 

IF(IUNIT(I ,K+4)- IBAM. GT. ICRL)  GO  TO  65 
GO  TO  20 

30  MX  »  ITRUCK( IT, 5) 
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c****  CALCULATE  THE  TRUCK  AMMO  LOAD 

LOAD  =  (IMIX(MX.L)  *  ITRUCK(IT,6)  +  99)  /  100 
C****  CHECK  AMMO  DEMAND  AGAINST  TRUCK  LOAD 
C  IF  UNIT  TYPE  8  UNLOAD  THE  WHOLE  TRUCK 

ITRUCKilT  6)°?Do*AND-  IUNIT^I‘1)  -NE-  3)G0  TO  50 

NEWLD  =  LOAD 
KIND  »  3 

C****  CALCULATE  UNLOAO  TIME  FOR  TRUCK 
C****  CALCULATE  THE  NUMBER  OF  ROUNDS  PER  WEAPON 
40  NRPW  =  ND  /  I UN  I T ( I , K+2 ) 

C****  CALCULATE  THE  NUMBER  OF  WEAPONS  LOADED  PER  TRUCK 
NW  »  MINQ(LOAD  /  NRPW, IUNIT(I,K+2) ) 

C****  CALCULATE  THE  RELOAD  TIME 
NNW  *  NW 

IF ( I UN I T ( 1 , 1 )  .EQ.  8) NNW  *  i 

IF CIUNIT(I.I) .EQ.8)  NRPW*LOAD 

DELAY  =  £  *  IRSTME(L,3)  +  NNW  *  (IRSTME(L.l)  + 

Z  IRSTME ( L , 2 )  *  NRPW  /  100) 

TOTTIM  »  TIME  +  DELAY 
IPARM(2)  *  IT 

C****  SCHEDULE  A  UNTARV  OR  UNTDEP  DEPENDING  ON  VALUE  OF  KIND 
CALL  SCHED (KIND, IPARM, TOTTIM) 

C**+*  ADJUST  AMMO  ON  TRUCKS  AND  CURRENT  AMMO  SUPPLY 
IUNIT( I, K+8)  «  IUNIT(I,K+8)  -  LOAD 
C****  THIS  LOGIC  IS  HERE  TO  SOLVE  THE  PROBLEM  OF  WEAPON 
C*~*  SYSTEMS  HAVING  DIFFERENT  BASIC  LOADS  FOR  THE  SAME  AMMO 
IF ( IUN IT ( I , 1 ) .NE. 1  .ANO.  IUNIT( I, 1) . NE.2)  GO  TO  45 
IF(IUNIT(I,K).NE.2)  GO  TO  45 
DO  1  JJ=3,56,12 
IF(K.EQ.OJ)  GO  TO  1 

IF( IUN IT(I,K).EQ. IUNIT(I.JJ))  GO  TO  42 
1  CONTINUE 

C  NO  EQUAL  AMMO  2  IN  THIS  UNIT  GO  TO  45 

GO  TO  45 

42  IUN  IT( I , JJ+8)* IUNIT( 1 ,0J+8)-L0AD 
45  IUNIT(I,K+4)  *  I  UN IT( I ,K+4)  +  NEWLD 
IF(IUNIT(I,1).EQ.8)  GO  TO  60 
C  DECREMENT  THE  NUM8ER  OF  ROUNDS  SHORT 

IUNIT(I,K+3)  -  IUNIT(I,K+3)  -  NEWLD 
IUNIT(I,K+2)  »  I UN  IT ( I , K+2 )  -  NW 
IF(IUNIT(I,1).EQ.8)  GO  TO  20 
GO  TO  10 
62  IFLAG  »  i 

65  IBAM*IUNIT(I ,K+l)*lUNIT(I,K+7) 

IRGNDaIUNIT(I,K+4)-IBAM 

IF ( IUN IT( I , K+3 ) . GT. IRGND)  GO  TO  70 

IRGND« IRGND - IUN IT( I , K+3 ) 

IUNIT(I,K+2)aO 


IUNIT(I,K+3)aC 
IUNIT(I,K+4)aIBAM+IRGND 
GO  TO  100 

IUNIT(I,K+3)«IUNIT(I,K+3)-IRGND 
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IUNIT(I,K+4)=IBAM-IUNIT(I,K+3) 

I F ( I FLAG . NE - 1 )  GO  TO  60 
GO  TO  100 

C****  CALCULATE  THE  PARTIAL  LOAD  OF  THE  TRUCK 
50  ITRUCK( IT, 6)  =  100  *  (LOAD  -  ND)/IMIX(MX,L) 
NEWLD  =  ND 
KIND  *  8 
GO  TO  40 
100  CONTINUE 
C 

RETURN 

END 
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s.  SUBROUTINE:  REPORT 

PURPOSE:  Provides  a  variety  of  reports  to  the  operator  given  the  present 
status  of  the  battle. 

COMMON  SLOCKS:  LOG 

CALLS:  None. 

IS  CALLED  BY:  CONTRL 

CALLING  PARAMETERS:  IPARM  (5)  -  (1)  ~  Number  of  Report  Desired 
LOCAL  ARRAYS:  IWPN  (20)  —  Alpha  description  of  the  ammunition  codes. 
FUNCTIONS: 

Branches  to  the  major  part  of  the  code  reference  by  the  type 
report  requested  in  the  CALLING  PARAMETERS. 

Requests  additional  information  from  the  operator  as  required. 

Accepts  the  additional  input  and  produces  the  resultant  report. 
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SUBROUTINE  REPORT  (IPARM) 

C****  WRITES  REPORTS  OF  VARIOUS  TYPES. 

Q**itr*  J  pQ}(  p£g  yg 

COMMON  /LOG/  IATP(4,30),  IASP(4,41),  IUNIT(75,69 ) , 

Z  ITRUCK( 560 ,7 ) ,  ITYPE(6,6),  IMIX(40,23),  INTER(9), 

Z  IRSTME(20,3) ,  IATPSD(5) ,  IDAY,  TIME, 

$  ICSA(20),  LPPAR(5) ,  IASPAM(4,20) ,  LUOUT,  TCIST,  TCILNG,  L00K(17) 
DIMENSION  IPARM ( 5) , IWPN (20) 

C 

DATA  IWPN/4HTANK, 3HT0W,4HPWDR .5H155HE, 6H155ICM, 6H155SMK, 

Z  7H155CLGP , 5H8 INHE , 6H8 INICM , 4HGSRS , 6HM0RTAR , 5HDIVAD , 3HAAH , 4HAH 1G , 
Z  7HSTINGER,6HDRAG0N,8HBUSHMSTR/ 

KIND  =  IPARM(l) 

IF (KIND  .LE.  0  .OR.  KIND  .GT.  9)RETURN 
GO  TO  (10,  20,  30,40,50,60,70,80,20),  KIND 
C 

C****  REPORT  TYPE  ONE 
10  CONTINUE 

C****  I TRUCK  UNIT  TRUCK  REPORT 
15  WRITE(2,325) 

325  FORMAT(/,"  UNIT  TRUCK  REPORT  PRINT  OPTIONS:'',/, 

Z  "  1  -  PRINT  ALL",/, 

Z  "  2  -  SINGLE  UNIT",/, 

Z  "  3  -RETURN",/, 

Z  "  ?  " ) 

READ ( 1 ,* )  IANS 

I F ( IANS . LT . 1 . OR . I ANS . GT . 3 )  GO  TO  15 
GO  TO  (150,160,170)  IANS 
C****  CYCLE  THROUGH  THE  UNITS 
150  DO  100  I  *  1,75 

C****  IF  TYPE  UNIT  IS  ZER0>  CONSIDER  INACTIVE  BYPASS 
IF( IUN IT (1,1)  .EQ.  Q)GO  TO  100 
C****  IF  UNNAMED  UNIT  GO  TO  100 

IF  ( IUN IT (1,7)  .EQ.  "  " )G0  TO  100 

CALL  TRUCK  (N) 

IF ( KIND . EQ . 9 )  RETURN 

IF ( IANS  .EQ.  2)  GO  TO  420 
100  CONTINUE 

170  IF (KINO  .EQ.  9)G0  TO  20 
GO  TO  90 
160  WRITE(2,290) 

READ (1,300)  NAME 
IF(NAME  .EQ.  "0")  GO  TO  15 
DO  110  K* 1 ,75 

IF(IUNIT(K,1).EQ.0)G0  TO  110 
I F ( IUN IT( K, 7 ) .EQ.NAME)  GO  TO  115 
110  CONTINUE 

WR ITE (2,431)  NAME 
GO  TO  160 

115  WRITE(LU0UT,200)  IUNIT(K,7) 

200  F0RMAT(1X,///,8X,  "  TRUCK  STATUS  REPORT  FOR  UNIT  ",A10,///, 

Z  "  TRK  NM  STATUS  MIX  PCLOAD  NXFAIL" ,/ ) 

DO  120  KK- 1,560 


IF ( ITRUCK(KK,4) .NE.K)  GO  TO  120 
NXFAIL3 ITYPE ( ITRUC  K(KK, 1) ,5)- ITRUC  K( KK ,7 ) 

WRITE(LU0UT,205 )  KK,  ITRUCK(KK,2) ,  ITRUCK(KK,3) ,  ITRUCK(KK,5) , 

Z  ITRUCK(KK,6) .NXFAIL 
205  F0RMAT(2X,6I7) 

120  CONTINUE 
GO  TO  160 

Qirtrk* 

C****  REPORT  TYPE  TOO 
20  CONTINUE 
C****  IUNIT  REPORT 
25  WRITE (2, 285) 

285  FORMAT (/,"  UNIT  STATUS  PRINT  OPTIONS:  ",/, 

Z  "  1  -  PRINT  ALL",/, 

Z  11  2  -  SINGLE  UNIT",/, 

Z  "  3  -  RETURN",/, 

Z  "  ?  " ) 

READ(li*)  IANS 

IF(IANS.LT.1.0R.IANS.GT.3)  GO  TO  25 
GO  TO  (350,420,410)  IANS 
C****  LOOP  THROUGH  UNITS 
350  DO  400  I  =  1,75 
C****  IF  NO  TYPE  CODE  BYPASS 

IF ( IUN IT (1,1)  .EQ.  Q)GO  TO  400 
C****  IF  NO  UNIT  NAME  GO  TO  400 

IF(IUNIT(I,7).EQ."  ")  GO  TO  400 
C****  PRINT  HEADER 

WRITE (LUOUT, 210) 

210  F0RMAT(42X,/// ,"  UNIT  STATUS", 43X, "UNIT  DATA" ,29X,"WPN  DATA",// 
Z.15X, "AMMO-CODE  WPN-TYP  WPN-ALIVE  CUR-SUP  RNDS-SHORT  PC8L-W  ON- 

ZTRKS  NO  WPN  SH  /  NO  SH  EA  TOT-DMD  "  ) 

WR ITE (LUOUT, 215) IUN IT( 1,7), IUN IT ( I , 1 ) , IUN IT (I ,2) , IUN IT ( I ,4) , 

Z  IUNIT( I ,3) ,IUNIT(I ,5) ,IUNIT(I ,68) 

215  FORMAT ( IX ,A10, 14, / ,"  SER  ATP  ", 12,13,"  KM",/,"  SER  ASP  ", 12,13,"  K 
ZM" ,/,  "  NO  HELO  ",I2) 

DO  395  J  -  1,5 
JU  *  12  *  J  -  4 

I F ( I  UN IT(I,JJ)  .EQ.  0)G0  TO  395 
NMSHT-0 

IF(IUNIT( I.JJ+2) .EQ.O)  GO  TO  216 
WSHT  -  IUNIT(I,JJ+3)  /  IUNIT(I,JJ+2) 

216  CONTINUE 

IPC8L»100*IUNIT( I, JJ+4)/ ( IUN IT (I ,JJ+1)*(  IUNIT(I ,J  J+7 ) ) 

WRITE (LUOUT, 220) IUN IT( I ,JJ) , IWPN(IUNIT(I,J J) ) , IUN IT( I ,JU+1) , IUN IT ( 
ZI.JJ+4) ,IUNIT(I,0J+3) ,IPCBL, IUN IT( I, JJ+8), IUN IT( I.JJ+2) ,NMSHT, 

Z  IUN IT( I, JU+11) 

220  F0RMAT(18X ,13 ,6X,A8, 17 , 18,5X , I5,4X, I6,2X, I5,8X , 14, "  /  " ,I4,5X, 15) 
395  CONTINUE 

C****  PRINT  STATUS  OF  UNIT  TRUCKS 
N  *  I 

CALL  TRUCK  (N) 

400  CONTINUE 

410  IF( KIND  .EQ.  9)G0  TO  30 


82 


GO  TO  90 
420  WRITE (2, 290) 

290  F0RMAT("  ENTER  JIFFY  UNIT  ID  (INPUT  0  TO  EXIT)  ") 

READ (1,300)  NAME 
IF  CNAME  .EQ.  "0")  GO  TO  25 
300  FORMAT(AIO) 

DO  430  K-1,75 

IF ( IUN IT ( K, 1) .EQ.O)  GO  TO  430 
IF ( IUN IT ( K ,7 ) .EQ.NAME)  GO  TO  435 

430  CONTINUE 
WRITE(2,431)  NAME 

431  FORMAT ("  UNIT  ",A10,"  NOT  FOUND") 

GO  TO  420 

435  WRITE(LU0UT,310)  NAME 

310  FORMAT (/,1X,"UNIT", IX ,A10 ,4X ."UNIT  DATA" ,22X, "WPN  DATA" ,/,10X , 

Z  "WPN" , 10X,"RNDS" , 18X ,"#  WPN  #  RND",/,1X,"WPN-TYP",2X, 

Z  "LIVE  CUR-SUP  SHORT  PCBL  ON-TRKS" ,3X ."SHORT  SH  EA  TOT-DMD" ) 

DO  385  KK=8 ,56,12 

IF ( IUN IT (K, KK).EQ.O)  GO  TO  385 

NMSHT3IUNIT(K,KK+3)/IUNIT(K, KK+2) 

IPC8L31CQ*IUNIT(K, KK+4)/(IUNIT(K,KK+l)*IUNIT(K,KK+7 ) ) 
WRITE(LU0UT,320)  IWPN (IUNIT(K.KK) ) , IUN IT ( K, KK+ 1 ) , IUNIT(K,KK+4) , 
Z  IUN IT ( K, KK+3 ) , IPC8L, IUNIT(K,KK+8) ,IUNIT(K,KK+2) ,NMSHT, 

Z  IUNIT(K,KK+11) 

320  FORMAT (IX ,A8,1X ,I3,2X,I5,2X,I3,2X,I6,4X,I4,2X,I5,1X,I5) 

385  CONTINUE 

C****  PRINT  STATUS  OF  UNIT  TRUCKS 
N  =  K 

CALL  TRUCK  (K) 

GO  TO  420 
C 

C****  REPORT  TYPE  THREE 
30  CONTINUE 

C****  SINGLE  ATP  REPORT  -  HOW  MANY  ACTIVE  ATP'S  ? 

PRINT  (2,*)  "  ENTER  NUMB  OF  ACTIVE  ATPS  (1,2,3,0R4)" 

REAC  (1,*)  NATP 

IF  (NATP  .LT.  1  .OR.  NATP  .GT.  4)  NATP  =  4 
DC  475  I  *  1 , NATP 

WRITE(LU0UT,235)I, I ATP ( 1 ,9) , IATP ( 1 ,10) , IATP ( 1 ,14) , I ATP (1,15 ) 

235  FORMAT (////,55X,"  ATP  STATUS  ",//,5X,"ATP  NO  ” , 13 ,// , 

Z  10X, "QUEUE  ARTY  MU",/,10X, 

Z  "SERVERS  ACTIVE", 2X, 13, 8X, 13,/, 10X, "TRUCKS  IN  Q" , 

Z  5X,I3,8X,I3,///,10X,"AMM0-C0DE  CUR-DMD  AMT-O/H  BASIC-LVL") 
DO  470  J  *  1,5 
JJ  =  J  *  3  +  13 

WRITE (LUOUT, 240) J , IATP (I ,J J+l ) , IATP( I, JJ ) , IATP (I , JJ+2 ) 

240  F0RMAT(13X,I3,4X, I4,4X ,I6,4X, 16) 

470  CONTINUE 
475  CONTINUE 

IF( KIND  .EQ.  9)G0  TO  40 
C 

GO  TO  90 
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C****  REPORT  TYPE  4 
40  CONTINUE 

C****  I ASP  REPORT  -  HOW  MANY  ASPS 

PRINT  (2,*)  "  ENTER  NUMBER  OF  ACTIVE  ASPS, 1 ,2,3 ,QR4" 

READ  (1,*)  NASP 

IF  (NASP  .LE.  0  .OR.  NASP  .GT.  4  )NASP  =  4 
DO  500  I  3  1,  NASP 
C****  OUTPUT  INFO 

WRITE (LU0UT.245) I, IASP (1,7), IASP ( 1 ,3) , IASP( 1 ,12)  ,IASP (1,13) 

245  F0RMAT(1X,////,55X,"  ASP  STATUS  ",///, 5X,"  ASP-NO  M3,///, 

Z  15X, "QUEUE  ROUTINE  GSRS" ,// ,10X, "SERVERS  ACTIVE", 

Z  2X, 15, 8X, 15, /,10X, "TRUCKS  IN  Q",5X,I5,8X, 15,///,"  INVENTORY 
ZAMMQ-COOE  AMT-O/H") 

JL00P=LPPAR(1) 

DO  495  J  =  l.JLOOP 
JJ  *  J  +  13 

WRITE(LU0UT,250)J, IASP( I , JJ ) 

250  FORMAT (19X,I3,4X,I8) 

495  CONTINUE 
500  CONTINUE 

I F( KIND  .EQ.  9)G0  TO  50 
GO  TO  90 


****  REPORT  TYPE  FIVE 
C****  ICSA  REPORT 
50  CONTINUE 

WRITE(LU0UT,225) 

225  F0RMAT(1X,////,55X,"  CSA-STATUS  ",//,50X," 
Z  /21X,"  AMMO  ",10X, "NUMBER-DRAWN  ") 
JLOOPaLPPAR(l) 

DO  450  I  =  l.JLOOP 
WRITE(LU0UT,230) I , ICSA( I ) 

230  F0RMAT(22X , 13 , 14X ,16) 

450  CONTINUE 

IF ( KIND  .EO.  9)G0  TO  60 
C 

GO  TO  90 


ROUNDS  DRAWN  FROM  CSA" , 


C 

C****  REPORT  TYPE  SIX 
C****  MULTIPLE  ATP  REPORT 


60  CONTINUE 

C****  LooP  THROUGH  ATP'S 
C****  WRITE  HEADERS 

WRITE(LU0UT,255) 

255  F0RMAT(1X ,////  ,45X,"  ATP  STATUS  -  COWAND  INFO  ",//,60X, 
Z"  AMMO  INVENTORY",/ .5X," ATP  NO  QUEUE  TRKS  1 


Z  4  5") 

00  600  I  »  1,4  , 

WR ITE ( LUOUT, 260 ) I , I ATP ( 1 , 15 ) , I ATP ( 1 , 16 ) , I ATP ( 1 , 19 ) , I ATP ( 1 , 14) , 
Z  IATP( 1,22), I ATP (1,25), I ATP (1,28) 

260  F0RMAT(9X,I2,"  MU  \I7,6X,I4,I6,,/,15X,"ARTY" ,I6,18X,3I5) 
600  CONTINUE 
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IF (KIND  . EQ.  9)G0  TO  70 
C 

GO  TO  90 

£**★*£★*** 

C****  REPORT  TYPE  SD/EN 
70  CONTINUE 

PRINT  (2,*)  "  ENTER  NUMBER  QF  ACTIVE  ASPS  " 

READ  (1,*)  NASP 

IF  (NASP. LE.O. OR. NASP. GT.4)  NASP  =  4 
C****  /WMO  REMOVED  FROM  ASPS 
C****  WRITE  HEADER 

WRITE(LU0UT,265) 

C  LOOP  THROUGH  ASPS 
DO  700  I  =  I, NASP 
WRITE  (LUOUT, 265)  I 

265  FORMAT  (//,20X,"ASP  "  ,I2,10X,"AMM0  TYPE" ,  10X ," AMMO  REMOVED") 

DO  690  J-  1,20 

WRITE  (LU OUT, 270)  J.IASPAM(I.J) 

270  FORMAT  (40X, 12 ,15X , 17) 

690  CONTINUE 
700  CONTINUE 

I F( KIND  .EQ.  9 )G0  TO  80 
C 
C 

GO  TO  90 

C****  REPORT  TYPE  EIGHT 

C****  TRUCKS  THAT  HAVE  BEEN  KILLED  OR  HAVE  BROKEN 
80  CONTINUE 

C****  LOOP  THROUGH  TRUCKS  FOR  DEAD 
LOOP  »  LPPAR(4) 

DO  800  I  =  l.LOOP 
C****  IF  NOT  DEAD,  GO  TO  800 

IF ( ITRUCK( 1,3)  .NE.  7)G0  TO  800 
C****  HAVE  DEAD  TRUCK,  PRINT  NUT 

WRITE (LUOUT ,275)1 ,IUNIT(ITRUCK( I ,4) ,7), ITRUCK( 1,1) ,ITRUCK( I ,5) 

275  FORMAT ("  TRUCK  NUMB", 14,"  OF  UNIT  ",A10,"  WHICH  IS  TYPE  "14,"  CARR 
ZYING  AMMN" , 14, "  IS  DEAD") 

800  CONTINUE 

00  810  I  =  1 , LOOP 

C****  IF  NOT  BEING  REPAIRED  GO  TO  310 
IF(ITRUCK(I,3)  .NE.  6)G0  TO  310 
C****  HAVE  BROKEN  TRUCK,  PRINT  INFO 
ISAVE** IUN IT ( ITRUCK(  1,4)  ,7) 

IF ( ITRUCK(  1 ,2)  .NE.l )  ISAVE=> "NON-UNIT” 

WRITE (LUOUT, 280) I , ISAVE, ITRUCK( 1,1), ITRUCK( 1,5) 

280  FORMAT("  TRUCK  NUMB",  14,"  OF  UNIT  \A10,"  WHICH  IS  TYPE  ",I3, 

Z  "CARRYING  AMMO  MIX" 14,"  IS  BEING  REPAIRED") 

810  CONTINUE 
90  RETURN 
END 
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t.  SUBROUTINE:  UNTAR V 

PURPOSE:  Processes  the  arrival  of  a  unit  truck  from  the  ASP,  ATP  or 
reloading  event. 

COMMON  3 LOCKS:  LOG 

CALLS:  IQ 

PUTQUE 

SCHED 

IS  CALLED  3Y:  ARM  Driver 

CALLING  PARAMETERS:  IPARM  (5)  -  (1)  -  Unit  Number 

(2)  --  Truck  Number 

LOCAL  ARRAYS:  None. 

FUNCTIONS: 

Determines  the  mix  of  ammunition  on  the  truck. 

Puts  the  truck  in  the  unit  queue. 

Changes  the  truck  statu*  code. 

Updates  the  ammunition  available  at  unit  trucks. 

If  a  reload  is  necessary,  schedules  a  reload. 
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SUBROUTINE  UNTARV  (IPARM) 

C****  EVENT  UNTARV  ~  ARRIVAL  OF  TRUCK  AT  UNIT. 

C 

C****  j.  pox  JAN  79 
C 

C****  IPARM  Cl )  --  UNIT  NUMBER 
C****  IPARM (2)  —  TRUCK  NUMBER 
C 

C****  SCHEDULES  —  RELOAD  IF  DEMAND  EXISTS. 

C 

C****  CHANGES  —  UNIT  AWO  ON  TRUCKS 

C  —  UNIT  TRUCK  QUEUE 

C 

COMMON  /LOG/  IATP(4,30),  IASP(4,41),  IUNIT(75,69), 

Z  ITRUCK(560,7) ,  ITYPE(6,6),  IMIX(40,23),  INTER(9), 

Z  IRSTME(20,3) ,  IATPSD(5),  I  DAY,  TIME, 

$  ICSA ( 20 ) ,  LPPAR(5),  IASPAM(4,20) ,  LUOUT,  TCIST,  TCILNG,  L00K(17) 
DIMENSION  IPARM(5) 

C 

C****  LOCAL  VARIABLES  : 

C****  MIX  —  INDEX  OF  AMMO  MIX 

C****  IND  —  INDEX  FOR  IUNIT  AMMO  TYPE 

C****  INDEX  —  AWO  TYPE  FOR  UNIT  AM10  TYPE  I 

C****  JLOOP  -  TOP  OF  LOOP  FROM  LPPAR 

C****  NUMR  —  NUMBER  OF  ROUNDS  OF  TYPE  INDEX  ON  THE  TRUCK 

C****  IRESFL—  RESUPPLY  FLAG  (0  »  NO  RESUP,  1  =  SCHED  RESUP) 

C****  I PR  -  UNIT  TRUCK  QUEUE  NUMBER 

C 

C****  INITIALIZE  RELOAD  FUG 
IRESFL  =  0 
C 

C****  DETERMINE  AMMO  MIX 

MIX  =  ITRUCKCIPARMC2),  5) 

IF (MIX. GT. 0)  GO  TO  1 
WRITE(2,6)  IPARM (2) 

6  F0RMAT(1X, "UNTARV  —  ZERO  MIX  ON  TRUCK  M3) 

RETURN 

C 

C****  PUT  TRUCK  IN  UNIT  QUEUE 
1  IPR  *  IQ(1,  IPARM (1 ) ) 

CALL  PUTQUE(IPARM(2),  IPR) 

C 

C****  CHange  TRUCK  STATUS  COOE 
ITRUCK(IPARM(2),  3)  -  1 
C 

C****  ADD  FMO  TO  UNIT  AVAIUBLE  AMMO  AND  CHECK  FOR  GENERATING  RELOAD 
JLOOP  »  LPPAR(2) 

DO  5  I  -  1, JLOOP 
IND  ■  1*12  -  4 

INDEX  «  IUNIT ( IPARM ( 1 ) ,  IND) 

IFCINDEX.EQ.O)  GO  TO  5 
C 

C****  IF  NO  AMMO  OF  THIS  TYPE  ON  TRUCK  GO  TO  5 


IFfNUMR*  *  ITRUCK^IPARM(2^6)  +  99)  /  100 

c  NUMR  ‘LE’  0)  G0  T0  5 

C****  HAVE  THIS  TYPE  OF  AMMO,  ADD  TO  UNIT 

IUNIT(IPARMCl),  IND+8)  -  IUNIT(IPARMfl) , IND+8)  +  NUMR 

C****  IF  NOT  A  FARP  GO  TO  4 

IF(IUNIT(IPARM(1) ,1).NE.8)  GO  TO  4 
C****  IF  NO  RELOAD  GO  TO  5 

I F( IUN IT( IPARM ( 1 ) » IND+4 ) . GT . IUN IT ( I PARM ( 1 ) , IND+1 )* I UN IT( I PARM ( 1 ) , I 

C^T+«  G0  TO  5 

IRESFLal 
GO  TO  5 

c****  if  RELOAD  IS  NOT  REQUIRED  GO  TO  5;  ELSE  SET  RELOAD  FLAG* IRESFL 

4  IF(IUNIT(IPARM(l),IND+7)  *  IUNIT{ IPARM(l) , IND+1)  .LE. 

I  IUNIT(IPARM(1), IND+4) )G0  TO  5 

C 

C****  SCHEDULE  RELOAD  FLAG 
IRESFL  *  1 

5  CONTINUE 

. , , ,  IF (IRESFL  .EQ.  1)  CALL  SCHED(2,  IPARM,  TIME) 

C****  HARD- WIRED  DATA  TO  HANDLE  STINGER 
C****  ammo  TYPE  15, MIX  11,24, 0R26  MORTA 
IFfMIX.NE.il)  GO  TO  10 
IFfMIX.NE.24)  GO  TO  10 
IF(MIX.NE.26)  GO  TO  10 
c****  ADD  AMMO  TO  THE  STINGER  WEAPONS 

IUNITflPARM(l) ,60)*IUNIT(IPARM(1) ,60)+9 
10  CONTINUE 
RETURN 
END 
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u.  SUBROUTINE:  UNTDEP 

PURPOSE:  Processes  a  truck  departing  a  unit  subsequent  to  being  emptied 
in  a  reload  event. 

C0M10N  8 LOCKS:  LOG 

CALLS:  INTRDK 
OPERA 
SCHED 

IS  CALLED  BY:  ARM  Driver 

CALLING  PARAMETERS:  IPARM  (5)  -  (1)  —  Unit  Number 

(2)  —  Truck  Number 

LOCAL  ARRAYS:  None. 

FUNCTIONS: 

Determines  ammunition  mix  required  by  the  truck. 

Routes  truck  to  ATP  or  ASP  as  is  appropriate  from  the  ammunition 
mix. 

Consider  truck  failures  and  interdiction  In  the  computation  of  the 
travel  time. 
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SUOROUTiNE  UNTDER  (IPARM) 
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v.  SUBROUTINE:  CREEVT 

PURPOSE:  Enables  interactive  creation  of  events  to  occur  later  in  the 
processing  cycle.  '  “  *  * 

COfWN  BLOCKS:  LOG 

CALLS:  READF 
SCHED 

IS  CALLED  BY:  Control 
CALLING  PARAMETERS:  None. 

LOCAL  ARRAYS:  None. 

FUNCTIONS: 

Displays  instructions  to  the  operator  as  to  the  procedures  in 
creating  an  event. 

Accepts  parameters  for  an  event  from  the  operator  and  schedules 
the  event. 
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4 


w.  SUBROUTINE:  EDIT 


PURPOSE:  Enables  the  listing  and/or  modification  of  the  data  stored  in 
the  block  COMMON  LOG. 

COWON  BLOCKS:  LOG 

CALLS:  REAOF 

IS  CALLED  BY:  CONTRL 

CALLING  PARAMETERS:  None. 

LOCAL  ARRAYS :  INTGR(IO)  —  Storage  for  up  to  10 

integer  number  fields  input  from  the 
console. 

REAL(IO)  —  Storage  for  up  to  10 
real  number  fields  input  from  the 
console. 

IWORD(IO)  —  Storage  for  up  to  10 
alpha  numeric  fields  input  from  the 
console. 

NAME(19)  —  Storage  for  the  names  of 
the  19  arrays  and  variables  in 
COMMON  LOG. 

LIMIT1(19)  —  Storage  for  the  upper 
limit  on  the  first  index  of  the 
arrays  and  variables  in  COMMON  LOG. 

LIMIT2(19)  —  Storage  for  the  upper 
limit  on  the  second  index  of  the 
arrays  and  variables  in  COMMON  LOG. 

FUNCTIONS: 

Displays  to  the  operator  a  message  requesting  input  as  to  what 
array  or  variable  in  COMMON  LOG  is  of  interest. 

Accepts  from  the  operator  the  message  as  to  which  array. 

Operator  then  Inputs  whether  he  wishes  to  list  or  change  the  array. 

Program  branches  to  the  proper  logic  and  lists  or  updates. 

An  input  of  "END"  exits  the  logic. 
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x.  SUBROUTINE:  EVINIT 

PURPOSE:  Reads  a  checkpoint/restart  file  for  mass  storage  assigned  as  T2. 

COMMON  BLOCKS:  EVENTS 

CALLS:  QINIT 

IS  CALLED  BY:  ARM  Driver 

CALLING  PARAMETERS:  None. 

LXAL  ARRAYS:  None. 

FUNCTIONS: 

Reads  file  containing  unused  events  from  previous  ARM  run. 

Asks  if  operator  wants  to  retain  these  events. 

If  operator  answers  "N"  or  "NO",  calls  QINIT  to  set  all  pointers 
to  zero  events. 


« 
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SUBROUTINE  EVINIT 
&*♦♦♦  READS  EVENT  FILE 
C*+**  M.  JONES  F-E3  7 9 

COMMON/ EVENTS/ JSTAT (6) , JEVDS  <102*. <♦) ,  I EV  S  <  5 , 1 C  2*> 
REAQ(7)  JSTAT,  JEVOS,  IEVS 


u****  ERASE  OLO  EVENTS  ? 

WRITS (2 » 10 ) 

1C  FORMAT  C*  DETAIN  EVENTS  CURRENTLY  SCHEDULED  ?  tYES/NO)  “*) 
REAO (  1 »  2 0 1  IANS 
2C  FORMAT(AIC) 

I F ( IA NS  .EQ.  “NO"  .OR.  IANS  .ED.  "N ” )  CALL  QINIT 

return 

ENO 


'V., 


y.  SUBROUTINE:  EVSTOP 

PURPOSE:  Writes  event  files  to  mass  storage  (Unit  7)  tape2  for 
checkpoint/restart. 

COMMON  BLOCKS:  EVENT 

CALLS:  None. 

IS  CALLED  BY:  ARM  Driver 

CALLING  PARAMETERS:  None. 

LOCAL  ARRAYS:  None. 

FUNCTIONS: 

Writes  all  of  event  file  to  mass  storage  to  enable 
chec  kpo  i  nt/  re  st  art . 
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SUBROUTINE  EVSTOP 
C****  WRITES  EVENT  FILE 
C***»  H.  JONES  FEB  79 

COMMON/EVENTS/ JSTAT{6 ) , JEVOS ( 1024 , 4 ) ,  IEVS (5 , 1024 ) 

WRITE(8)  JSTAT,  JEVDS,  IEVS 

RETURN 

END 
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z.  SUBROUTINE:  FINTK 


PURPOSE:  Finds  the  truck  in  the  queue  (passed  parameter)  with  the  proper 
amnunition  code  (passed  parameter)  and  the  smaller  percent  load  of 
aimtunition. 

COMMON  .BLOCKS:  LOG 

CALLS:  GETQUE 
PUTQUE 

IS  CALLED  BY:  ATP 

LDPWDR 

RELOAO 

CALLING  PARAMETERS:  NQUE  —  Number  of  the  queue  to  be  searched. 

NRND  —  Round  type  required. 

NTRUCK  —  Number  of  truck  found  in  NQUE,  equal  zero 
if  no  truck  found  in  queue. 


LOCAL  ARRAYS:  None. 

FUNCTIONS: 

Pull  the  first  truck  from  the  queue  and  save  it,  and  put  it  back 
in  the  queue. 

Search  through  the  trucks  in  the  queue,  saving  the  one  with  the 
proper  amnunition  type  and  the  smallest  percentage  load. 

When  you  pull  the  check  truck  from  the  queue,  the  search  is 
complete  since  the  queues  are  first  in  first  out  (FIFO). 
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C**«*  PULL  TRUCK  FROM  QUlUE 
25  CALL  GETUUt ( ITRCK.NQUE) 


C***»  DETERMINE  AMMO  MIX  TYPE 
MIX  =  1 TRUCK< ITRCK,  5) 
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END 


aa.  SUBROUTINE:  GETQUE 


PURPOSE:  Removes  the  first  truck  from  its  queue. 

COftlON  SLOCKS:  QUENUM 
QUEPNT 

CALLS:  None. 

IS  CALLED  BY:  ASP 
ATP 
FINTK 
TRKPUT 

CALLING  PARAMETERS:  ITEM  —  Truck  number  removed  from  the  queue,  zero  if 

queue  is  empty. 

NUMQUE  —  Number  of  queue  to  be  accessed. 

LOCAL  ARRAYS:  None. 

FUNCTIONS: 

Removes  lead  truck  from  the  queue. 

Updates  the  queue  printer  tables. 
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SU3RQ  UTINE  GETQUE  ( ITEM  ,  NUMQUE) 

C****  GETS  rTz'1  F°0M  QUEUE  NU MQ  UE 

C+***  TO  GET  TRUCK  FROM  QUEUE  4  —  CALL  GETQUE  ( 

C ****  H.  JONES  OEC  73 

COMMON  /QUENUM/  NH£AO(136> 

COMMON  /QUEPNT/  IPNT(5oO) 

ITEM  =  0 
LITEM  =  Q 

IPO INT  =  NMtAO (NUVQUE) 

C 

10  IF  (IP.OINT  .EQ.  0)  GO  TO  2Q 
LITEM  =  ITEM 
ITEM  =  I°0 1  NT 
IPOINT  =  IPNT(ITEM) 

GO  TO  10 

20  IFfLITEM  .  GT.  0)  IPNT (LITEM)  =  0 
IF (LITEM  .EQ.  0)  NHEAO CNUMQUE)  =  0 
C 

RETURN 

END 


N,  4) 
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bb.  SUBROUTINE:  IN  IT 

PURPOSE:  Reads  data  base  from  T1  into  the  LOG  and  queue  COMMONS. 

COMMON  BLOCKS:  LOG 

QUENUM 

QUEPNT 

CALLS:  CONTRL 
RDJIFF 
SCHED 
TRKTIM 

IS  CALLED  BY:  ARM  Oriver 
CALLING  PARAMETERS:  None. 

LOCAL  ARRAYS:  None. 

FUNCTIONS: 

Reads  data  base  Into  COMMONS  LOG,  QUENUM,  QUEPNT. 

Oisplays  message  requesting  the  planned  battle  time  to  stop  the 
simulation. 

Accepts  operator  input  as  to  time  to  stop  the  simulation  and 
schedule  stop  event. 

Calls  TRKTIM,  CONTRL,  RDJIFF  to  complete  run  initialization. 
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50  8R0  UT I N£  INIT 
C****  INITIALIZES  simulation 

C  *■*  *'*  w.  JONES  JAN  79 
C 

COMMON  /LOG/  IATO(l,33),  IASO(U,uu,  I'JNI‘r  (  75 , 6  3)  . 

Z  ITR  UC'<  ( 560  *  7  )  ,  ITY°E (6 , 6 )  *  I  MIY  (U  0 , 2  3  )  ,  I^re(9)  , 

Z  IRS  T  M£ ( 2  0  *  3 )  ,  IATP50(5),  IDAv,  TINE  * 

3  ICS  A (20)  ,  LPPAR<5),  I A3P A M  (4 , 2 0 ) ,  LUOUT,  -CIST,  TCILNG, 
C 0.1  NO N  /QUcNUM/  IM  E A  0  (135) 

COMMON  /QUE3NT/  ITEMS  (560) 

DIMENSION  I°A  RM  ( 5 ) 

•DATA  LOOK  /17*C/ 

****  READ  PILES  WITH  ALL  COMMON  DATA 

RE  AO ( 3 )  I a TP,  I ASP, IUMIT, TT RUC < *  IT Y P£ , I M IX , INTER , I=>$TME, 

Z  IATPS3,I CAY , time, ICSA,LPPAR, I ASPAM.LUOUT, TCIST, 

Z  TCIlNG,  IHEAO,  ITEMS 
C 

C  IF  3UIL0ING  ANSWER  elLES  PYPASS  3TE°S 

WRITE (2*20) 

2G  FORMAT  {"  ARE  YOUR  CREATING  AN  A N SW £ R  CILE  (  Y  0=  N)  '*) 

REAQ (1,21) IANS 

21  FORMAT(AIO) 

IF  ( IA  NS »  fq  ,  "Y"  ,JP.  IANS  .  EQ  .  “YES'* )  GO  TO  10 

C 

WRITE (2,22) 

22  FORMA  T  ('*  ENTER  TIME  TO  STO3  SI  “UL ATIQN  "> 

RE  AC ( 1 ,  •)  TSTOP 

IPARM(l)  =  "SCHEDULED  " 

IPARM ( 2 )  =  "  STOP" 

I P  A  R  M  ( 3  )  =  "  " 

I P  A  R  M  ( v*  )  =  "  " 

call  SCHEO  (17,  1 3  ARM,  TSTOP) 

C 

CAlL  Tc<T Im 
10  CALL  CCNTRL  (TIME) 

TIME  =  TCIST 

IF ( IA  NS  . EQ . " Y"  .OR,  IANS  . EQ . "YE S" ) RE T URN 
C 

0**»*  REAQ  FILE  for  OEMANOS 
CALL  RO J  IFC 
RETURN 
ENO 
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cc.  SUBROUTINE:  INTRDK 


PURPOSE:  Determines  if  truck  is  interdicted  while  en  route. 

COMMON  BLOCKS:  LOG 

CALLS:  None. 

IS  CALLED  BY:  ASP 

ASPARV 

ATP 

ATPARV 

CSAARV 

RELOAO 

UNTDEP 

LDPWDR 


CALLING  PARAMETERS: 
i nterdiction 


NUMTK  —  The  number  of  the  truck  to  be  considered. 
TLOST  —  =•  0  if  no  interdiction,  *  time  lost  if 

occurs. 


LOCAL  ARRAYS:  None. 


FUNCTIONS: 

Determines  if  truck  is  in  zone  1  (mostly  artillery  interdiction), 
or  zone  2  (mostly  Air  Force  interdiction). 

Increments  the  accumulator  of  the  number  of  trucks  that  have  been 
en  route  in  zone  1  or  zone  2. 

Determine  if  truck  is  interdicted. 

If  yes,  assess  the  time  lost  to  system  for  truck  replacement. 
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SUUrfOUTINE  INTKOK  ( IUJ11TK  »  TL  OS  I ) 
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dd.  SUBROUTINE:  IQ 


PURPOSE:  To  provide  the  queue  number  associated  with  the  activity  being 
processed. 

COMMON  BLOCKS:  None 

CALLS:  None 

IS  CALLED  BY:  ATP 

ATPAR1 
ATPAR2 
ATPARV 
RELOAD 
UNTAR V 
LDPWDR 

CALLING  PARAMETERS:  ITYPE  —  Type  of  queue  being  searched,  varies  from  1 
to  10,  see 

page  11  for  codes. 

NUM  —  Which  member  of  type  ITYPE. 


LOCAL  ARRAYS:  None. 

FUNCTIONS: 

Check  to  see  if  queue  type  is  valid. 

Branches  to  proper  calculation  of  queue  number  based  on  ITYPE. 
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FUNCTION  IGUTYPE.  NUM) 

C+***  RETURNS  QUEUE  NUMBER 
C  *■*  *  *  J I  tt  FuX  JAN  79 

L****  LOCAL  VARIABLES: 

C****  ITYPE  IS  T^z  TY  3E  QF  QUEUE  TO  BE  CONSIDERS''1 
C 

c**-**  CHECK  FOR  '/ALIO  QUEUE  NUMBER 

IF ( IT YPE  .GT.  C  .4NO.  ITYOE  .LE.  10)  GO  TO  5 
WRITE  (2  » 3  0  3 ) 

STOP 


L 

5 

C 

c**  *  * 

1C 


GO  TO  (13,20,30.40,50,60,70,33,90,100),  ITVDr 

UNIT  QUEUE 
IQ  =  NUM 
GO  TO  230 


C 

c**** 

3  G 

C 

£*+  ** 

40 

C 

c*+ 


c 

c**  *♦ 

50 

C**** 

73 


ATP  QUEUE  FOR  CSA-AT3  TRUCKS 
IQ  =  133  *  NUM 
GO  TO  200 

ATP  QUEUE  FOR  ASP-AT3  TRUCKS 
IQ  =  134  f  NUM 
GO  TO  203 

ARTILLERY  SERVER  QUEUE  AT  THE  AT3 
IQ  =  10  3  *  NUM 
GO  TO  233 

1ANEJVER  SERVE®  QUEUE  AT  T HE  ATP 
IQ  =  112  *  NUM 
GO  TO  200 

NOT  USED 
CONTINUE 

GO  TO  2  J  0  _ _  __ 

ASP  QUEUE  FO°  CSA-ASP  TRUCKS 
IQ  =  120  ♦  NUM 
GO  tc  200 


C 

£*■»■**  ROUTINE  SERVER  QUEUE  At  ’HE  ASp 
33  IQ  =  12**  ♦  NUM 
GO  TO  200 


C**»*  GSpS  SERVE3  QUEUE  AT  TH £  ASP 
93  IQ  =  123  ♦  NUM 

_ GO  TO  20  0 _  — _ 

NOT  USED 
lv.C  CONTINUE 
C 

230  RETURN 

330  FORMAT ("  BAO  QUEUE  NUM3ER  IN  FUNCTION  IQ") 
ENO 
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ee.  SUBROUTINE:  LDPWDR 

PURPOSE:  Unloads  the  truck  containing  powder  canisters  (ammunition  type 
3)  when  155  HE  and  ICM  (aimiunition  codes  4  and  5)  are  removed  from  the  ATP. 

COWON  BLOCKS:  LOG 

CALLS:  FINTK 
INTRDK 
IQ 

OPERA 

PUTQUE 

SCHED 

IS  CALLED  BY:  ATP 

CALLING  PARAMETERS:  NRNDS  -  Number  of  powder  rounds  needed. 

IPARM  (5)  -  (1)  —  1,  indicates  artillery. 

(2)  —  ATP  number. 

LOCAL  ARRAYS:  I IPARM  (5)  —  Builds  the  parameters  to  schedule  trucks  back 
to  the 

ASP  or  CSA. 

FUNCTIONS: 

Sets  the  ammunition  type  equal  to  3. 

Checks  the  ASP -ATP  queue  for  powder  trucks. 

If  insufficient  ammunition  in  the  ASP-ATP  queue,  the  CSA-ATP  queue 
is  checked. 

Decrements  powder  anmunition  files. 

Schedules  empty  powder  trucks  to  arrive  at  ASP  (ASPAR  1). 
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SUBROUTINE  LDPWDR( NRNDS, IPARM) 

C****  UNLOADS  POWDER  TRUCK  WHEN  ARTY  AMMO  TAKEN  FROM  ATP 
C 

C****  j.  pox  JAN  79 
C 

C****  NRNDS  IS  NUMBER  OF  POWDER  CANISTERS  NEEDED 
C****  IPARM  IS  IDENTICAL  TO  ATP 
C****  NOTHING  IS  RETURNED 

C****  SCHEDULES  ~  ASPAR1  ARRIVAL  OF  ASP-ATP  TRUCK  AT  ASP 
C****  ~  CSAARV  ARRIVAL  OF  CSA-ATP  TRUCK  AT  CSA 

COMMON  /LOG/  IATP(4,30) , IASP(4,41) , IUNIT(75,69) , 

Z  ITRUCK(560,7) ,  ITYPE  6,6),  IMIX(40,23),  INTER (9) , 

Z  IRSTME(20,3) ,  IATPSD(5),  IDAY ,  TIME, 

$  ICSA (20) ,  LPPAR(5) ,  IASPAM(4,20) ,  LUOUT,  TCIST,  TCILNG,  L00K(17) 
C 

C****  LOCAL  VARIA8LE  DEFINITION 

0****  n pram  _  PARAMETERS  FOR  SCHEDULING  POWDER  TRUCK  REFILL 
0****  MIX  -  NUMBER  OF  AMMO  MIX  ON  TRUCK  FOR  COMMON  IMIX 
0****  NR  .  hard  wired  AMMO  CODE  FOR  POWDER  CHARGES 
C****  nrntk  -  NUMBER  OF  POWDER  CHARGES  ON  THE  TRUCK 
0****  NUmtk  -  POWDER  TRUCK  ID  NUMBER 
C****  mr  .  AMMO  TYPE  FOR  POWDER 
C****  NRDSAV  -  NUMBER  OF  CANISTERS  STILL  NEEDED 
0****  NQUE  -  ASP-ATP  QUEUE  NUMBER 
0****  numtk  -  POWDER  AMMO  TRUCK 
C****  NALTQ  -  CSA  -ATP  QUEUE  NUMBER 
C****  NRNTK  -  NUMBER  OF  CANISTERS  ON  TRUCK 
0****  dist  _  road  DISTANCE  TRUCK  WILL  TRAVEL 
C****  icod  -  EVENT  TYPE  TO  BE  SCHEDULED 
C****  ITKTYP  -  TYPE  OF  TRUCK 
C****  TRIM  -  ROAD  TRAVEL  TIME 
c****  TFAIL  -  TIME  LOST  DUE  TO  FAILURE 
c****  TMINO  -  TIME  LOST  DUE  TO  INTERDICTION 
C****  Time  -  TIME  OF  SCHEDULED  EVENT 
DIMENSION  IPARM(5),IIPRAM(5) 

DO  1  I  ■  1,5 
IIPRAM(I)  -  0 
1  CONTINUE 

c****  SET  AMMO  TYPE  AND  NUMBER  OF  ROUNDS  NEEDED 
NR  -  3 

NRDSAV  *  NRNDS 

C****  FIND  TRUCK,  SAVE  QUEUE  WE  ARE  WORKING  IN 
5  NQUE  -  IQ(3,IPARM(2)) 

NNQ  *  NQUE 

CALL  F INTK( NNQ, NR, NUMTK) 

C**-**  if  HAVE  TRUCK  GO  TO  10,  ELSE  CHECK  CSA  QUEUE 
IF (NUMTK  .GT.  0)GO  TO  10 
NALTQ  -  IQ(2,IPARM(2)) 

NNQ  -  NALTQ 

CALL  FINTK(NNQ,NR, NUMTK) 

c****  if  HAVE  TRUCK  GO  TO  10,  ELSE  WRITE  ERROR  AND  CALL  CONTRL 
IF(NUMTK  .GT.  0)G0  TO  10 
WRITE(2,15)IPARM(2) 


15  FORMAT ("  NO  POWDER  AT  ATP  ",  12  ) 

WRITE(LU0UT,30) IPARM(2) 

30  FORMAT("  NO  POWDER  AT  ATP  \I2) 

RETURN 

C****  HAVE  TRUCK.  IF  INSUFFICIENT  AMMO, GO  TO  20 
10  MIX  »  ITRUCK(NUMTK,5) 

NRNTK  -  (IMIX(MIX.NR)  *  ITRUCK(NUMTK,6)  +99)  /  100 
IF(NRNTK  .LT.  NRDSAV)GO  TO  20 
C****  SUFFICIENT  AMMO,  OFFLOAD  AND  PUT  BACK  IN  QUEUE 

ITRUCK(NUMTK,6)  *  (NRNTK  -  NRDSAV)  *  100  /  IMIX(MIX.NR) 
CALL  PUTQUE  (NUMTK,  NNQ) 

C****  DECREMENT  AMMO  ON  HAND  AND  DEMAND 

IATP(IPARM(2) ,22)»IATP(IPARM(2) ,22)-NRNDS 
I  ATP  ( IP  ARM  ( 2 ) ,  23  )=I  ATP  ( IP  ARM  ( 2 ) ,  23 )  -  NRNDS 
RETURN 

C****  INSUFFICIENT  AMMO 
20  I TRUCK (NUMTK, 6)  »  0 
C****  DECREMENT  ROUNDS  NEEDED 
NRDSAV  *  NRDSAV  -  NRNTK 
C****  IF  DESTINATION  IS  ASP  GO  TO  25 
IF (NNQ  .EQ.  NQUE)GO  TO  25 
C****  GOING  TO  CSA 

DIST  =  IATP ( IP ARM ( 2 ) ,1) 

ICOD  »  9 
IIPRAM(3)  =  1 
GO  TO  27 

25  GIST  «  IATP( IPARM(2) ,2) 

ICOD  »  12 

IIPRAM(3)  -  IATP( IPARM(2) ,6) 

27  IIPRAM(l)  *  IPARM(2) 

I IPRAM (2)  *  NUMTK 
ITKTYP  -  ITRUCK(NUMTK.l) 

TRTM  =  60  *  DIST  /  ITYPE( ITKTYP, IDAY+3) 

ITRUCK(NUMTK,3)  »  4 

CALL  OPERA(NUMTK,TRTM,TFAIL) 

CALL  INTRDK(NUMTK.TMIND) 

TOniM  -  TIME  +  TRIM  +  TFAIL  +  TMIND 
CALL  SCHED(IC00, IIPRAM.TOTTIM) 

C****  GO  GET  ANOTHER  TRUCK 
GO  TO  5 
END 


ff.  SUBROUTINE:  LOOKEV 


PURPOSE:  Enables  selective  monitoring  of  event  generation  and  processing. 
COMMON  BLOCKS:  LOG 

CALLS:  None. 


IS  CALLED  8Y:  ARM  Driver 
SCHED 


CALLING  PARAMETERS: 


is  being 


KIND  --  Event  code  (range  of  values  1-17) 

IPARM  (5)  —  Event  parameters 

TLTIME  —  Time  of  scheduled  event 

IGET  —  1  if  event  is  being  processed,  =  0  if  event 

scheduled. 


LOCAL  ARRAYS:  NAME(17)  —  Contains  the  alphanumeric  names  of  subroutines 
processing  the  event  types  and  is  used  for  display  purposes. 


FUNCTIONS: 

Determines  from  the  LOOK  array  if  the  type  event  being  handled  is 
to  be  displayed. 

Display  event  data,  if  applicable. 
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gg.  SUBROUTINE:  NXTQUE 


PURPOSE:  Oi splays  the  first  truck  in  the  queue  without  changing  the  queue 
sequence. 

COWON  BLOCKS:  QUENUM,  QUEPNT 

CALLS:  None. 

IS  CALLED  BY:  CONTRL 
TRKPUT 

CALLING  PARAMETERS:  ITEM  —  Number  of  the  first  truck  in  the  queue. 

NUMQUE  --  Number  of  the  queue  to  be  examined. 

LOCAL  ARRAYS:  None. 

FUNCTIONS: 

Determines  the  number  of  the  first  truck  in  queue  NUMQUE. 
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SUBROUTINE  NXTQUE  (I7E"1t  NUMQUE) 
c****  SHOHS  NEXT  I T£'1  IN  QUEUE  (LEAVES  IT  IN) 
C****  m.  JONES  FE3  79 

COMMON  /QUENUM/  NHEAO  (135) 

COMMON  /OUEPNT/  IP  NT  (560) 

ITEM  =  0 

IPOINT  =  NHEAO (NUMQUE) 

C 

LC  IF (IPOINT  .EQ.  Q)  GO  TO  20 
ITEM  =  IPOINT 
IPOINT  =  I°NT ( ITEM ) 

GO  TO  13 
C 

2C  RETURN 
ENO 
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hh.  SUBROUTINE:  OPERA 


PURPOSE:  Determines  if  reliability  failure  exists  and  assesses  the 
resultant  time  lost. 

C0M10N  BLOCKS:  LOG 

CALLS:  None. 

IS  CALLED  BY:  ASP 

ASPARV 

ATP 

ATPARV 

CSAARV 

DEMANO 

HELARV 

UNTDEP 

LDPWOR 


CALLING  PARAMETERS: 

the  route. 

zero 


KTRUCK  ~  Truck  being  considered. 

TRTME  --  Unopposed  travel  time  for  the  next  link  of 

DELAY  —  Time  to  repair  the  truck  if  failure  occurs, 

otherwise. 


LOCAL  ARRAYS:  None. 

FUNCTIONS: 

Determines  truck  type. 

Determines  mean  time  between  failure  for  truck  type. 

Determines  time  until  the  next  failure. 

If  time  to  next  failure  is  less  than  the  travel  time  assesses 
repair  time,  and  resets  the  time  since  last  failure  clock. 
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ii.  SUBROUTINE:  PUTQUE 


PURPOSE:  Places  the  truck  in  the  queue  by  setting  queue  pointers. 

COMMON  BLOCKS:  QUENUM 
QUEPNT 


CALLS:  None. 

IS  CALLED  BY:  ASPAR1 
UNTAR V 
FINTK 
LDPWDR 
TRKPUT 

CALLING  PARAMETERS:  ITEM  —  Truck  to  be  placed  in  queue. 

NUMQUE  —  Queue  number  receiving  truck. 

LOCAL  ARRAYS:  None. 

FUNCTIONS: 

Places  truck  in  queue  by  updating  pointer  tables. 


o  o 


-*  4k 


SUBROUTINE  PUTQUE  (ITEM,  mumQUE) 
PUTS  I  TEN  IN  QUEUE  NUMQUt 
H.  JONES  OEC  73 
COMMON  /QUENUM/  NM EAO (13  6) 

COMMON  /QUEPNT/  I?NT(5bQ) 

IOLOH  =  NhEAC (NUMQUt ) 

NHEAO (NUMQUE)  =  ITEM 
IP  NT ( ITEM)  =  IOLOH 
RETURN 
ENO 


jj.  SUBROUTINE:  QINIT 


PURPOSE:  Initializes  the  event  queue  directory. 

COMMON  BLOCKS:  EVENTS 
CALLS:  None. 

IS  CALLED  BY:  EVINIT 
CALLING  PARAMETERS:  None. 

LOCAL  ARRAYS:  JFORE  (1024)  —  Equivalenced  to  the  first  1024  words  of 
array  JEVDS 

and  contains  the  pointers  to  the  previous 


events. 


array  JEVDS 
events. 

array  JEVDS 
events. 


JBACK  (1024)  —  Equivalenced  to  the  second  1024  words  of 

and  contains  the  pointers  to  the  subsequent 

JTIME  (1024,  2)  —  Equivalenced  to  the  last  2048  words  of 
and  contains  the  time  parameters  of  the 


FUNCTIONS: 

Sets  number  of  event  space  available  to  max  of  1024. 

Zeroes  first  event  position,  last  event  position. 

Sets  pointer  arrays  so  that  empty  event  one  points  to  empty  event 
two  etc. 

Sets  the  pointer  of  empty  1  to  0. 

Sets  forward  pointer  of  empty  event  1024  to  zero. 
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kk.  SUBROUTINE:  RDIEXO 

PURPOSE:  Updates  IUNIT  array  for  anrnunition  requirements  of  this  demand 
pulse. 

COWON  BLOCKS:  LOG 

CALLS:  SCHED 

IS  CALLED  BY:  DEMAND 

CALLING  PARAMETERS:  NUNIT  —  Unit  Number 

LOCAL  ARRAYS:  IPARM(5)  —  Parameters  to  schedule  the  demand  event. 
FUNCTIONS: 

Zero  IPARM  array. 

Determine  the  number  of  demand  pulses  for  the  unit  this  run. 

SCHED  a  demand  event  based  on  the  number  of  demand  pulse  being 
greater  than  one. 

Update  number  of  weapons  alive,  number  of  weapons  short  anrnunition 
and  the  total  number  of  rounds  short  for  each  ammunition  type. 


ooo  oo  o  o  oo  oooooo n  oooo 


SUBROUTINE  RDIEX0( NUNIT) 

UPDATES  IUNIT  EACH  PULSE  OF  A  MULTI-DEMAND  AND  SCHED  DEMAND 
JIM  FOX  -  FEB  1979 

COMMON  /LOG/  IATP(4,30),  IASP(Ml),  IUNIT(75 ,69) , 

Z  ITRUCK(560,7) ,  ITYPE(6,6),  IMIX(40,23),  INTER ( 9 ) , 

Z  IRSTME(20,3) ,  IATPSD(5),  IDAY,  TIME, 

3  ICSA(20),  LPPAR(5) ,  IASPAM(4,20) ,  LUOUT,  TCIST,  TCILNG,  L00K(17) 

LOCAL  VARIABLES 
NUN IT  -  UNIT  NUMBER 

NCELLS  -  NUMBER  OF  DEMAND  PULSES  IN  DEMAND  UNIT  RECORD 
IFLIV  -  NEGATIVE  OF  NUMBER  OF  TUBES  KILLED 
TOTTIM  -  COMPUTED  TIME  FOR  SCHEDULING  AN  EVENT 

DIMENSION  IPARM(5) 

DO  5  I  3  1,5 
IPARM(I)  3  0 
5  CONTINUE 

SET  IPARM  TO  CALL  TO  SCHEDULE  DEMAND 
IPARM(l)  3  NUNIT 

FIND  NUMBER  OF  DEMAND  PULSE  CELLS 
XCELLS  3  IUNIT(NUNIT,69) 

NCELLS  *  XCELLS 
IF (NCELLS. LE.l)  GO  TO  100 

COMPUTE  THE  TIME  OF  THE  NEXT  DEMAND  EVENT  AND  SCHEDULE  IT. 

TOTTIM  3  TIME  +  TCILNG  /  XCELLS 
IF(T0TTIM  .GT.  TCIST  +  TCILNG )GO  TO  100 
CALL  SCHED ( 1 , IPARM, TOTTIM ) 

100  CONTINUE 

IF (NCELLS. LE.l)  NCELLS3! 

IF(XCELLS.LE.l)  XCELLS- 1. 

UPDATE  IUNIT  WITH  A  PART  OF  THE  DEMAND  DATA 
DO  20  I  3  1,5 
IND  3  I  *  12  -  4 
IF  NO  DATA  TO  UPOATE  GO  TO  20 
IF( IUNIT (NUNIT , IND+10 )  .LE.  O)G0  TO  20 
COMPUTE  WHICH  PULSE  THAT  THIS  UPDATE  REPRESENTS 
NUMPL  3  (TIME  -  TCIST)  /  (TCILNG  /  XCELLS)  +  .5 
IF( NCELLS. LE.l)  NUMPL-1 
COMPUTE  NEGATIVE  SURVIVOR  FACTOR 
LOWER  NUMBER  OF  SURVIVORS  FOR  THIS  PULSE 
COMPUTE  THE  NUMBER  OF  DEAD  TO  BE  ASSESSED  THIS  PULSE  -  NMDEAD 
NMDEAD  3  (IUNIT(NUNIT,IND+9)+NUMPL-l)  /  NCELLS 
C  CCMPUTE  NUMBER  OF  RNDS  LOST  WITH  DEAD  WPN 

NDEDR0-NMDEAD*IUNIT(NUNIT,IND+4)/IUNIT(NUNIT, IND+1) 

C  IF  NEG.  ROUNDS  ON  HAND  -  NONE  LOST. 

IF(IUNIT(NUNIT, IND+4)  .LE.  0)  NDEDRD  3  0 
IUNIT(NUNIT, IND+1)  3  IUNIT(NUNIT, IND+1)  -  NMDEAD 
IF ( IUNIT(NUNIT, IND+1 ) . LT . 0 )  IUNIT(NUNIT, IND+1 ) 30 
C****  ASSUME  SINGLE  PULSE  UNIT 

IUNIT(NUNIT,IN0+2)3IUNIT(NUNIT,IND+10) 


C****  CHECK  FOR  ARTY  UNITS 

IF(IUNIT(NUNIT,  1)  .GE.4.AND.  IUNIT(NUNIT,  1) . LE.6)  IUNIT(NUNIT, IND+2 ) 
Z  *  IUNIT(NUNIT, IND+1) 

C  IF  FARP,  NUMBER  OF  WEAPONS  SHORT  AMMO  =  NUM  IN  CELL 

IF(IUNIT(NUNIT,1)  .EQ.  8) IUNIT(NUNIT, IND+2)  *  IUNIT(NUNIT, IND+2) 

Z  +  ( IUN IT ( NUN  IT, IND+10)  +  NUMPL  -  I)  /  NCELLS 
C  UPDATE  A  PORTION  OF  ROUNDS  SHORT 

C  COMPUTE  THE  NUMBER  OF  ROUNDS  SHORT  TO  BE  ASSESSED  THIS  PULSE-WRD 
NMRD  =  ( IUN IT(NUNIT, IND+1 1)  +  NUMPL  -  1)  /  NCELLS 
IUNIT(NUNIT,  IND+3  )=  IUNIT(NUNIT,  IND+3  )+W!RD-(  IUNIT(  NUNIT,  IND+7 ) 

Z  *WiDEAD  -  NDEDRD) 

C  COMPUTE  AMMO  ON  HAND 

IUNIT(NUNIT, IND+4)  »  IUNIT( NUNIT, IND+4)  -  (NDEDRD  +  NMRD) 

20  CONTINUE 
RETURN 
END 
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11.  SUBROUTINE;  RDJIFF 


PURPOSE:  Reads  output  file  created  by  the  attrition  model  of  ammunition  usage  and 
updates  IUNIT  for  RDIEXO. 

COWON  BLOCKS:  LOG 

CALLS:  EOF 
SCHED 
DECODE 

IS  CALLED  BY:  INIT 
CALLING  PARAMETERS:  None. 

LOCAL  ARRAYS:  IRDJF  (64)  —  Array  resulting  from  reading  attrition  model  record 

and  converting  it  for  ARM  usage. 

IPARM  (5)  —  Parameter  list  to  schedule  the  demand  events. 

RDJF  (64)  —  Array  for  temporary  storage  of  attrition  model  record. 

FUNCTIONS: 


Reads  attrition  model -produced  file  record  of  64  real  words. 

Copies  words  2  through  64  into  an  integer  array. 

Decodes  alphanumeric  first  word  (unit  name  from  attrition  model)  into 
the  integer  array. 

Finds  matching  unit  number  and  replaces  unit  name. 

Updates  IUNIT  with  ammunition  usage  data  for  use  by  subroutine  RDIEXO. 
Schedules  the  first  demand  pulse. 

Determines  the  number  of  demand  pulses  and  places  in  array  IUNIT. 
Branches  to  first  function  until  records  are  processed. 


OO  OO  O 


SUBROUTINE  RDJ IFF 


READS  OUTPUT  FILE  CREATED  BY  JIFFY. 

TRANSLATES  THE  JIFFY  IDS  TO  ARM  NUMBERS 
SCHEDULES  A  DEMAND  EVENT  FOR  EACH  UNIT  FIRING  AMMO. 

UPDATES  IUNIT  FOR  SINGLE  PULSE  DEMAND  UNITS. 

C 

C  JIM  FOX  -  FEB  1979 
C 

C  LOCAL  VARIABLE  DEFINITION 

C  UNTMAP  -  JIFFY  UNIT  NAMES  ASSOCIATED  WITH  ARM  UNIT  NUMBERS. 

C  IRDJF  -  JIFFY  CREATED  INTERFACE  RECORD  64  WORDS  LONG  PER  RECORD 

C  1  -  JIFFY  UNIT  ID 

C  2  -  NUMBER  OF  AH  IN  CELL (AH  ONLY 

C  3  -  ARM  AMMO  CODE 

C  4  -  NUMBER  OF  WEAPONS  ALIVE 

C  5  -  NUMBER  OF  WEAPONS  SHORT  AMMO 

C  6  -  TOTAL  NUMBER  OF  ROUNDS  SHORT 

C  7-11  ECT  REPEAT  OF  2  -  6 

C  LUIN1  -  JIFFY  PRODUCED  INPUT  FILE 

C 

C  IAUN  -  LOOP  INDEX 

C  IND1  -  COMPUTED  INDEX  TO  ACCESS  IUNIT  AMMO  TYPE 
C  IAMMO  -  AMMO  TYPE  FROM  IUNIT 
C  IJF  -  LOOP  INDEX 

C  IJFAM  -  COMPUTED  INDEX  TO  ACCESS  IRDJF  FOR  AMMO  TYPE 
C  IJAM  -  IRDJF  AMMO  TYPE 

C  I  -  LOOP  INDEX 

C  III  -  LOOP  INDEX 

C  IIJ  -  LOOP  INDEX 

C  IJF  -  LOOP  INDEX 

C  IU  -  LOOP  INDEX 

C  IN  -  INDEX  TO  SEARCH  FOR  UNIT  NAME 
C  INI  -  MATCHED  ARM  UNIT  NUMBER 
C  IAUN  -  LOOP  INDEX 

C  IND1  -  INDEX  COMPUTED  FROM  IAUN  TO  ACCESS  IUNIT  FOR  AMMO  TYPE 

C  IA  LOOP  INDEX  < 

C  IAM  -  INDEX  CCMPUTED  FROM  IA  TO  SEARCH  IRDJF 

C  IAMM  -  AMMO  TYPE  FROM  IRDJF 

C  IJFAM  -  INDEX  COMPUTED  FROM  IJF  TO  ACCESS  IRDJF 

C  IJAM  -  AMMO  TYPE  FROM  IRDJF 

C  IUA  -  COMPUTED  INDEX  FROM  IU  TO  ACCESS  IUNIT 

C  IUAM  -  AJtlO  TYPE  FROM  IUNIT 

C  NHELCL  -  ACCUMULATOR  FOR  NUMBER  OF  HELICOPTERS  IN  CELLS 

C  NMDEAD  -  NUMBER  OF  AH  LOST  TO  FARP 

C  NNI  -  INDEX  TO  ACCESS  IRDJF, 2, 7, 12  ECT 
C  NRNSH  -  ACCUMULATOR  FOR  NUMBER  OF  ROUNDS  SHORT 
C  NWPNAL  -  ACCUMULATOR  FOR  NUMBER  OF  AH  RETURNING  ALIVE 

C  NWPNSH  -  ACCUMULATOR  FOR  NUMBER  OF  AH  SHORT  ROUNDS 

C  NCELLS  -  NUMBER  OF  CELLS  IN  FARP  RECORD 

C  XCELL  -  REAL  VARIABLE  EQUAL  TO  NCELLS 
C  DELTIM  -  TIME  INTERVAL  BETWEEN  FARP  CELL  PROCESSING 
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C  III  -  LOOP  IHDEX 

C  XII  -  REAL  EOIJAL  TO  III 

C  IIL  -  COMPUTED  INDEX  TO  FILL  IEXOUT 

C  IIJ  -  COMPUTED  INDEX  TO  FIND  IRDJF  TO  BUILD  IEXOUT  RECORD 

C  TOTTIM  -  TIME  TO  SCHEDULE  EVENT 

C 


Z 

Z 

$ 


COMMON  /LOG/  IATP(4,30),  IASP(4,41),  IUNIT(75 ,69) , 

ITRUCK(560,7),  ITYPE(6,6),  IMIX(40,23),  INTER (9 ) , 

IRSTME(20,3),  IATPSD(5),  IDAY,  TIME, 

ICSA(20),  LPPAR (5 ) ,  IASPAM(4,20) ,  LUOUT,  TCIST,  TCILNG,  L00K(17) 
D IMENS ION  IRDJF (64 ) , IPARM (5 ) , RD JF ( 64 ) 

DO  10  I  *1,5 


IPARM ( I )  -  0 
10  CONTINUE 


C****  ZERO  LAST  EVENT' S  DEMAND 
C****  LOOP  FOR  UNITS 
DO  2  II  *  1,75 
C ****  LOOP  FOR  5  AMMO'S 
DO  3  12  *  1,5 

C****  LOOP  FOR  THREE  ELEMENTS 
DO  4  13  *  1,3 

C****  COMPUTE  THE  FUN  INDEX 
14  *  4  +  12  *  12  +  13 
IUNIT ( II , 14 )  *  0 
4  CONTINUE 
3  CONTINUE 
2  CONTINUE 


LUIN1  *  9 
REWIND  LUIN1 

C  READ  RECORD  FROM  JIFFY  PRODUCED  FILE. 

20  READ (LU INI )RDJF 

C  IF  END  OF  FILE  LUIN1  GO  TO  WRAPUP  (200) 

IF(EOF (LUIN1) )2Q0,15 

C  HAVE  A  RECORD,  CONVERT  UNIT  TO  ARM  NUMBER 
C****  DECODE  UNIT  NAME  AND  COPY  OTHER  REALS  TO  INTEGER 
15  DO  5  1=2,64 

IRDJF(I)=RDJF(I) 

5  CONTINUE 

DECODE (10, 1,RDJF(1))  IRDJF(l) 

1  FORMAT(AIO) 

DO  16  IN  *  1,75 

IF( IUNIT( IN ,7 )  .EQ.  IRDJF(l) )G0  TO  30 
16  CONTINUE 
C  NO  MATCH 

WR ITE ( LUOUT , 60 ) IRD JF ( 1 ) 

60  FORMATC  NO  MATCH  FOR  JIFFY  UNIT  ",A10) 

GO  TO  20 

C  HAVE  A  MATCH  REPUCE  UNIT  NAME  WITH  IN 
30  IRDJF(l)  •  IN 
INI  «  IN 
IPARM(l)  *  INI 
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C  IF  NOT  SINGLE  PULSE  UNIT  GO  TO  100 
IF(IUNIT(IN1,69)  .GT.  0)G0  TO  100 
C  HAVE  A  SINGLE  PULSE  UNIT,  UPDATE  IUNIT  AND  CALL  SCHEDULE 

C  FIND  PROPER  AMMO  IN  ARM  UNIT  (IUNIT) 

40  DO  80  IAUN  =  1,5 
IN01  -  12  *  IAUN  -  4 
I AMMO  =  lUNIT(INl.INDl) 

IF(IAMMO  .EQ.  0)GO  TO  80 
DO  79  IJF  *  1,5 
IJFAM  *  IJF  *  5  -  2 
I  JAM  =*  IRDJF(  IJFAM) 

(2  ■*■»■** 

C  SCENARIO  DEPENDENT  CODE  TO  READ  IN  SECOND  AMMO  CODE  2 
IF(IJAM  .EQ.  25  .AND.  IAUN  .EQ.  3)G0  TO  45 

(2**** 

I F ( I JAM . EQ . 12 )  IRDJF( IJFAM  +  3)  ■  IRDJF( IJFAM  +  3)  *  90 
IF ( I JAM  .NE.  IAMMO  .OR.  IJAM  .EQ.  0)G0  TO  79 
C  HAVE  EQUAL  AMMO  TYPES,  UPDATE  IUNIT  WITH  NEW  DATA. 

C ****  UPDATE  FOR  DEMAND  DATA  IN  UNIT  STATUS  REPORT 

45  IUN IT( INI , IND1+9 )  *  IUNIT( INI , IND1+1 )  -  IRDJF(IJFAM+1) 

IF( IUNIT (INI, IND 1+9)  .LT.  0) IUNIT( INI , IND1+9 )  *  0 
IUNIT(IN1 .INDl+10)  -  IRDJF(IJFAM+2) 

IUNIT(IN1,IND1+11)  =■  IRDJF(IJFAM+3) 

IRDJF( IJFAM)  -  0 

C  END  OF  IUNIT  UPDATE  FOR  THIS  AMMO  TYPE 
GO  TO  80 

79  CONTINUE 

C  NO  UNIT  AMMO  MATCH 

WRITE(LU0UT,78)  INI, IJAM 

78  FORMAT ("  NO  AMMO  MATCH  IN  IUNIT.  UNIT  \I5,"  AMM0\I5) 

80  CONTINUE 

C  SCHEDULE  DEMAND 

TOTTIM  -  TCIST  +  .5  *  TCILNG 
CALL  SCHED(1,IPARM, TOTTIM) 

GO  TO  20 

C  HAVE  A  MULTIPLUSE  UNIT.  IF  ARTY  GO  TO  120 
100  IF ( IUNIT( INI ,1)  .GT.  3  .AND . IUNIT(IN1 ,1)  .LT.  7)G0  TO  120 
C  HAVE  A  FARP  COUNT  THE  CELLS 

NCELLS  -  0 
NHELCL  -  0 
NWPNAL  -  0 
NWPNSH  »  0 
NRNSH  «  0 
C 

00  102  I  *  1,10 

NNI  *  5  *  I  -  3 

IF(IRDJF(NNI)  .LE.  0)G0  TO  102 

NCELLS  -  NCELLS  +  1 

NHELCL  -  NHELCL  +  IROJF(NNI) 
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NWPNAL  =  NWPNAL  +  IRDUF(NNI+2) 

NWPNSH  =  NWPNSH  +  IRDUF (NN 1+3) 

NRNSH  *  NRNSH  +  IRDUF(NNI+4) 

102  CONTINUE 

C  IF  NO  CELLS,  GO  TO  THE  NEXT  UNIT  RECORD 
IFCNCELLS  .LE.  0)G0  TO  20 
XCELL  »  NCELLS 

C  COMPUTE  TIME  BETWEEN  DEMAND  PULSES 

DELTIM  *  TCILNG  /  XCELL 

C  UPDATE  NUMBER  OF  DEMANDS  FOR  THIS  FARP 
IUNIT( INI ,69)  =  NCELLS 

C  TAKE  CARE  OF  THE  SINGLE  CELL  FARP 
IF (NCELLS  .ST.  1)G0  TO  103 
DELTIM  =■  TCILNG  /  2. 

C  FIND  PROPER  AMMO  TO  UPDATE 

103  DO  104  III  *  1,5 
IIU  -  III  *  12  -  4 

C  IF  WRONG  AMMO  GO  TO  104 

IF ( IUNIT ( INI s IIJ )  .NE.  IRDUF(3) )G0  TO  104 

C  HAVE  PROPER  AMMO  UPDATE  HOLDING  AREA  IN  IUNIT 
IUNIT( INI, IIU+9)  «  NHELCL  -  NWPNAL 
IUNIT( INi , IIJ+10)  -  NWPNSH 
IUNIT(IN1,IIJ+11)  »  NRNSH 

C  SCHEDULE  FIRST  DEMAND  EVENT 

TOTTIM  =■  TIME  +  DELTIM 
CALL  SCHED (1,1 PARM , TOTTIM ) 

GO  TO  20 

104  CONTINUE 
GO  TO  20 

C  HAVE  AN  ARTY  UNIT.  BUILD  EXO  AND  SCHED  DEMAND 

102  TOTTIM  -  TCIST  +  60. 

CALL  SCHED (l.IPARM, TOTTIM) 

C  FIND  AMMO  TYPES  TO  UPDATE  IUNIT  HOLDIND  FOR  ARTY 
IUN  IT  (INI,  69 )  =>  TCILNG  /  60.  +  .5 
DO  300  IA  -  1,5 

C  SELECT  AMMO  RECORD  FROM  IRDUF 

IAM  -  5  *  IA  -  2 
IAMM  -  IRDJF(IAM) 

C  FIND  CORRESPONDING  UNIT  AMMO 

DO  290  IU  ■  1,5 
IUA  -  12  *  IU  -  4 
IUAM  -  IUNIT ( INI , IUA ) 

C  IF  NOT  THE  SAME  AMMO  GO  TO  290 
IF (IUAM  .NE.  IAMM)GO  TO  290 

C  HAVE  AMMO  MATCH.  SET  UP  FILE  IUNIT. 

IUNIT(INl,IUA+9)«  IUNIT(IN1, IUA+1)  -  IRDUF(IAM+1) 
IF(IUNIT(INl,IUA+9)  .LT.  0)IUN IT ( INI . IUA+9 )  »  0 
IUNIT(IN1,IUA+10)  -  IRDUF ( IAM+2) 

IUNIT(IN1,IUA+11)  -  IRDUF (IAM+3) 

GO  TO  300 

290  CONTINUE 

WRITE  (LUOUT, 291) INI, IAMM 
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291  FORMAT ("  NO  IUNIT  AMM  MATCH  -  RDJ IFF,  UNIT  ",I5," 
GO  TO  20 
300  CONTINUE 
GO  TO  20 

200  WRITE (LUOUT, 400) 

WRITE(2,400) 

400  FORMAT ( 11  HAVE  FINISHED  RDJ  IFF  ") 

RETURN 

END 


AMMO  ",I5) 
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inn.  SUBROUTINE:  REAOF 


PURPOSE:  Accepts  up  tp  10  integers,  real  and/or  alpha  fields  from  the  operator. 

COMMON  BLOCKS:  None 

CALLS:  EOF 
FLOAT 

IS  CALLED  BY:  EDIT 

TRKPUT 

CALLING  PARAMETERS:  LU  —  Logistical  unit  number  of  input. 

NUM  —  Maximum  number  of  each  type  of  field  to  be  accepted  in 
a  single  line. 

INTGR  —  Array  for  storing  up  to  NUM  integer  fields. 

REAL  —  Array  for  storing  up  to  NUM  real  fields. 

IWORD  —  Array  for  storing  up  to  NUM  alphanumeric  fields. 

LOCAL  ARRAYS:  ICHR(82)  --  Local  array  to  accept  field  of  80  characters  input  by 

the  operator. 

IALDIG(IO)  --  Local  array  to  store  the  integers  1  through  0. 

FUNCTIONS: 


Reads  80  characters  of  input  from  logical  unit  LU. 

Initialize  integer,  real  and  alphanumeric  storage  arrays. 

Determines  if  each  field  is  real,  integer  or  alphanumeric. 

Builds  fields,  character  by  character  using  blanks  and/or  commas  as 
separators. 
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SUBROUTINE  READF  (LU,  NUM,  INTER,  REAL,  IWORD) 

C****  RETURNS  UP  TO  NUM  INTEGERS,  REALS,  AMD  STRINGS. 

C****  BLANKS  AND  COMMAS  ARE  DELIMITERS 
C****  H.  JONES  1979 

DIMENSION  INTGR(l) ,  REAL ( 1 ) ,  IWORD ( 1 ) 

DIMENSION  ICHR(82) ,  IALDIG(IO) 

DATA  IBLANK  /"  "/,  IPERD  ICOMMA  IMINUS 

DATA  IQUOT/1H"/ 

DATA  IALDIG  /"1",,,2"  ,"3"  ,"4"  ,"5"  ,"6"  ,"7"  ,"8",  "9"  ,"07 
ICHR (81 )  =  IBLANK 
ICHR(82)  =  IQUOT 
C 

C****  READ  RECORD,  ZERO  OUT  OLD1  INTGR,  REAL,  IWORD 
READ(LU, 100}  (ICHR(I) ,  1=1,80) 

IFCEOF(LU)  .NE.  0)  GO  TO  60 

DO  4  1=1, NUM 

INTGR(I)=0 

REAL(I)=0. 

4  IWORD(I)  =  IBLANK 
KW0RD=0 
KINTGR=0 
KREAL=0 
N=0 
C 

C****  CHECK  NEXT  CHARACTER  IN  RECORD 
C****  SKIPPING  BLANKS  ********** 

10  MINUS  =  1 

11  N=N+1 

IF(N.EQ.81)  GO  TO  60 
IF(lCHR(N).EQ. IBLANK)  GO  TO  11 
C 

C****  DETERMINE  IF  CHAR  IS  NUMBER  OF  ALPHA 
IFCICHR(N)  .EQ.  IQUOT)  GO  TO  41 
IF( ICHR(N)  .NE.  IMINUS)  GO  TO  12 
MINUS  =  -1 
GO  TO  11 

12  ISTART  =  N 
NUMB=0 

IF(ICHR(N).EQ.IPERD)  GO  TO  28 
DO  15  1=1,10 

IF(ICHR(N) .EQ. IALDIG(I) )  GO  TO  20 
15  CONTINUE 
GO  TO  40 
C 

C****  BUILDING  INTEGER  OR  INTEGER  PART  OF  REAL 
20  N«N+1 

I F( ICHR (N )  .NE.  IBLANK  .AND.  ICHR(N)  .NE.  IPERD 
Z  .AND.  ICHR(N)  .NE.  ICOMMA  )  GO  TO  20 
C 

C****  CALCULATE  VALUE  OF  INTEGER 
IEND  =  N-l 
NUMB-0 

DO  25  I- ISTART, IEND 


DO  24  >1,9 

IF ( ICHR ( I )  .EQ.  IALDIG (J ) )  GO  TO  25 

24  CONTINUE 
>0 

25  NUMB  -  NUMB  +  J  *  10  **(IEND-I) 

IFCICHR(N)  .EQ.  IPERD)  GO  TO  28 

C 

C****  NUMBER  WAS  INTEGER,  STORE  IT,  CHECK  FOR  BLANKS 
KINTGR  *  KINTGR  +1 
INTGR(KINTGR)  *  NUMB  *  MINUS 
GO  TO  10 
C 

C****  NUMBER  WAS  INTEGER  PART  OF  REAL,  NOW  BUILD  DECIMAL. 

28  RNUMB  =  FLOAT (NUMB) 

IS  TART  -  N+l 

IF(ICHR(ISTART)  .EQ.  IBLANK)  GO  TO  39 
30  N-N+l 

IF(ICHR(N).NE. IBLANK  .AND.  ICHR(N)  .NE.ICOWA  )  GO  TO  30 
C 

C****  CALCULATE  VALUE  OF  DECIMAL 
I END  =  N-l 
IDECPL  *  1 
NUMB=0 

DO  38  I- ISTART, IEND 
DO  34  >1,9 

IFCICHR(I)  .EQ.  IALDIG  (J))  GO  TO  35 

34  CONTINUE 
0-0 

35  NUMB  =  NUMB  +  J  *  1Q**(IEND-I) 

38  IDECPL  -  IDECPL  *  10 
C 

C****  ADD  INTEGER  AND  DECIMAL 

D  ECML-FLOAT  ( NUMB )  /  FLOAT  (.IDECPL) 

RNUMB  -  RNUMB  +  DECML 

39  KREAL  =  KREAL  +  1 
REAL(KREAL)  -  RNUMB  *  MINUS 
GO  TO  10 

C 

C****  BUILDING  STRING  ALPHANUMERIC 

40  N-N+l 

IF(ICHR(N).NE. IBLANK  .AND.  ICHR(N) .NE.ICOMMA  )  GO  TO  40 
GO  TO  44 

41  ISTART  »  N+l 

42  N-N+l 

IFCICHR(N)  .NE.  IQUOT)  GO  TO  42 
44  IEND  -  N-l 

KWORD  -  KWORD  +  1 

LENSTR  -  IEND  -  ISTART  +  1 

IF(LENSTR  .GT.  10)  LENSTR  ■  10 

ENCOOEC LENSTR,  90,  IWORD(KWORD) )  (ICHRQCKK),  KKK- ISTART,  IEND) 
GO  TO  10 
C 

60  RETURN 
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90  FORMAT ( 1QA1 ) 
100  F0RMAT(8QAi) 
END 


nn.  SUBROUTINE:  SCHED 


PURPOSE:  Schedules  events. 

COMMON  BLOCKS:  None 

CALLS:  CONTRL 
LOOKEV 
PUTEVT 

IS  CALLED  8Y:  ASP 

ASPARV 

ASPAR1 

ATP 

ATPARV  , 

CSAARV 

DEMAND 

HELARV 

RELOAD 

IN  IT 

LDPWDR 

RDIEXO 

RDJIFF 

CALLING  PARAMETERS:  ITYPE  —  ARM  event  code. 

IPARM(5)  —  Parameters  for  the  event. 

TIME  —  Time  that  the  event  is  scheduled  to  occur. 


LOCAL  ARRAYS:  None. 
FUNCTIONS: 


Sets  IPARM(5)  to  event  type. 

Calls  LOOKEV  to  determine  if  event  should  be  displayed. 

Calls  PUTEVT  to  place  the  event  in  the  EVENT  array. 

If  PUTEVT  was  unsuccessful  displays  message  and  calls  CONTRL. 
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SUBROUTINE  SCHED  (ITYPE,  IPARM,  nME) 
C****  INTERFACE  ROUTINE  TO  SCHEDULE  EVENT 
C ***•*■  H.  JONES  OEC  7* 

DIMENSION  I  PA  RM ( 5 ) 

IP  ARM (5) =ITYPE 

CALL  LOOKEV  (ITYPE+3,  IPAPM,  TI*E*C.,  0) 
ITH  =  TIME 

ITS  =  (TIME  -  ITH)  *  3  BO  0 

CALL  PUTEVT  (IPARM,  ITh,  ITS,  ICrtECKI 

IFdCHECK  . EQ.  0)  GO  TO  20 

WRITE (2 , 30 )  ICHECK 

CALL  CONTPL (TIME) 

20  RETURN 

30  FORMAT <“  TOO  MANY  EVENTS  --  ",I6l 
ENO 
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oo.  SUBROUTINE:  SETQUE 

PURPOSE:  Initializes  truck  queues  to  zero  by  replacing  all  pointers  with  zeros. 

COMMON  BLOCKS:  QUENUM 
QUEPNT 

CALLS:  None 
IS  CALLED  BY:  TRKPUT 

CALLING  PARAMETERS:  ITEMS  —  The  number  of  trucks  that  will  be  placed  in  queues. 

NUMQUE  —  Total  number  of  queues  receiving  trucks. 

LOCAL  ARRAYS:  None. 

FUNCTIONS: 


Zeroes  the  queue  directories. 


SU8.9:UTTN£  SETQUt  (ITEMS.  NUMQUE) 

C***+  SETS  UP  .'UMQUc  EMPTY  QUEUES  FQp  IT-MS. 
C***A  H.  JONES  Q EC  7<? 

COMMON  /QUENUM/  NMEA0(136> 

COMMON  /QUEPNT/  I°NT(560) 

00  10  1  =  1 »  NUMQUE 
10  NHEAO(I)  =  0 
00  2C  1=1, ITEMS 
20  IPNT(I)  =  0 
9ETUPN 
ENO 
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pp.  SUBROUTINE:  TRKPUT 


PURPOSE:  Enables  interactive  truck  assignment,  unassignment,  and/or  reassignment 
to  queues. 

COMMON  BLOCKS:  None 

CALLS:  GETQUE 
NXTQUE 
PUTQUE 
READF 
SETQUE 

IS  CALLED  BY:  CONTRL 
CALLING  PARAMETERS:  None. 

LOCAL  ARRAYS:  INTGR  (10)  —  Holds  up  to  10  integer  fields  from  the  operator  input. 

REAL  (10)  —  Holds  up  to  10  real  fields  from  the  operator  input. 
IWORD  (10)  —  Holds  up  to  10  alphanumeric  fields  from  the  operator 
input. 

FUNCTIONS: 


Displays  names. 

Accepts  operator  input  by  calling  READF  and  does  one  of  the  following. 
Puts  truck  into  queue. 

Pulls  truck  from  queue. 

Lists  truck  from  a  queue. 

Initializes  pointers  removing  all  trucks  from  all  queues. 
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SUBROUTINE  TRKPUT 

C****  ALLOWS  INTERACTIVE  TRUCK  QUEUE  RE-ASSIGNMENT 
C****  H.  JONES  FEB  79 

DIMENSION  INTGR(IO),  REAL (10 ) ,  IWORD(IO) 

C 

WRITE(2,10) 

10  FORMAT ( IX , “ COWAND  EXAMPLES 
Z  IX, "GET  3  FROM  35 
Z  IX, "PUT  3,  10  IN  105 
Z  IX, "LIST  105  ",/, 

Z  1X,"TAKE  ALL  OUT  ",/, 

Z  IX, "END  ",/) 

C 

15  WRITE (2, 20) 

20  FORMAT ("  ...  ") 

CALL  READF  (1,  10,  INTGR,  REAL,  I WORD) 

IF( IWORD ( 1 )  .£Q.  "END"  .OR.  IWORD(l)  .EQ.  "E")  GO  TO  50 
IF(IW0RD(1)  .EQ.  "PUT"  .OR.  IWORD(l)  .EQ.  "P")  GO  TO  30 
IF( IWORD (1)  .EQ.  "LIST"  .OR.  IWORD(l)  .EQ.  "L")  GO  TO  40 
IF( IWORD (1 )  .EQ.  "GET"  .OR.  IWORD(l)  .EQ.  "G")  GO  TO  25 
IF( IWORD ( 1 )  .EQ.  "TAKE"  .OR.  IWORD ( 1 )  .EQ.  "T")  GO  TO  60 
GO  TO  15 
C 

C****  GET  TRUCK  FROM  QUEUE  WITHOUT  RE-ORDERING  QUEUE 

25  II  *  INTGR(l) 

12  *  INTGR (2) 

IF (INTGR (3)  .NE.  0)  GO  TO  15 
I FLAG  *  0 

CALL  NXTQUE  (IFIRST,  12) 

26  CALL  NXTQUE (NTRK,  12) 

IF(NTRK.EQ.O)  GO  TO  15 

IF (NTRK  .EQ.  IFIRST  .AND.  I FLAG  .NE.  0)  GO  TO  15 
CALL  GETQUE(NTRK,  12) 

IF ( II  .EQ.  IFIRST)  GO  TO  15 

IF (II  .NE.  NTRK)  CALL  PUTQUE  (NTRK,  12) 

IF  LAG  «  1 
GO  TO  26 
C 

C****  pyx  TRUCK  IN  QUEUE 
30  II  -  INTGR(l) 

12  »  INTGR(2) 

13  -  INTGR(3) 

IF (INTGR (3)  .EQ.  0)  13  -  INTGR (2) 

IF(INTGR(3)  .EQ.  0)  12  -  INTGR (1) 

00  35  1-11,12 
35  CALL  PUTQUE  (I,  13) 

GO  TO  15 
C 

C****  LIST  TRUCKS  IN  QUEUE 

40  CALL  NXTQUE  (IFIRST,  INTGR(l) ) 

IF ( IF IRST  .EQ.  0)  GO  TO  15 
42  CALL  GETQUE(NTRK,  INTGR (1) 

CALL  PUTQUE (NTRK,  INTGR(l)) 
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WRITE (2 ,45}  NTRK 
45  F0RMAT(1X,I5) 

CALL  NXTQUE  (INEXT,  INTGR(l) ) 
IFCINEXT  .NE.  IFIRST)  GO  TO  42 
GO  TO  15 
C 

C****  TAKE  ALL  TRUCKS  OUT  OF  QUEUES 
60  CALL  SETQUE  (560,  136) 

GO  TO  15 
C 

50  RETURN 
ENO 
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qq.  SUBROUTINE:  TRKTIM 

PURPOSE:  Initializes  the  ITRUCK  arrays  with  time  since  last  failure. 

COMMON  8L0CKS:  LOG 
CALLS:  RANF 
IS  CALLED  BY:  INIT 
CALLING  PARAMETERS:  None. 

LOCAL  ARRAYS:  None. 

FUNCTIONS: 

Asks  operator  if  truck  times  since  last  failure  should  be  initialized; 
if  no,  returns.  Else  loops  through  the  trucks. 

Determines  the  truck  type  and  mean  time  between  failure  (MTBF)  for  the 
truck  type. 

Draws  a  number  from  a  uniform  distribution  (0-1)  and  multiply  it  by 
MTBF  to  determine  the  time  since  the  last  failure. 

Stores  calculated  time  since  the  last  failure  in  ITRUCK. 
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SUBROUTINE  TRKTIM 
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rr.  SUBROUTINE:  TRUCK 
PURPOSE:  Writes  the  status  of  unit  trucks 
COMMON  BLOCKS:  LOG 
CALLS :  None 
IS  CALLED  BY:  Report 
CALLING  PARAMETERS:  None. 

LOCAL  ARRAYS:  None. 

FUNCTIONS: 

Finds  trucks  assigned  to  a  given  unit  and  prints  the  current  status 
of  each  truck. 
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6.  DESCRIPTION  OF  ASSOCIATED  PROGRAMS.  Although  ARM  is  self  sufficient  to 
accomplish  all  tasks  associated  with  ammunition  resupply  simulation  there 
are  several  other  programs  that  have  been  developed  to  assist  the  ARM 
operator  in  accomplishing  the  tasks  associated  with  data  base  development. 
This  section  will  present  a  description  of  each  of  these  programs  and  their 
functions.  See  appendix  A  for  computer  listings  of  these  programs. 

a.  PROGRAM:  HJEDIT 

PURPOSE:  To  call  HUEDIT  which  allows  editing  of  data  base 
separately  from  ARM. 

COMMON  BLOCKS:  LOG,  QUENUM,  QUEPNT 

CALLS:  HUEDIT 

IS  CALLED  8Y:  Operator 

CALLING  PARAMETERS:  None 

LOCAL  ARRAYS:  None 

FUNCTIONS:  Connects  the  data  base  and  HUEDIT,  generates  an  output 
file  of  revised  data  base,  returns  keyboard  and  binary 
file. 

b.  PROGRAM:  HUEDIT 

PURPOSE:  To  permit  building  of  initial  data  base  or  modification 
of  existing  data  base  without  calling  HJARMANOTHER. 

COMMON  BLOCKS:  LOG,  QUENUM,  QUEPNT 

CALLS:  EDIT,  UPDATE 

IS  CALLED  BY:  HJEDIT 

CALLING  PARAMETERS:  NONE 

LOCAL  ARRAYS:  None 

FUNCTIONS:  Calls  EDIT  if  editing  of  data  is  desired. 

Calls  UPDATE  if  updating  of  arrays  is  desired. 

c.  SUBROUTINE:  EDIT 


PURPOSE:  To  edit  data  base,  functions  the  same  as  the  edit 
subroutine  within  ARM  (see  w.  Subroutine:  Edit) 


PROGRAM  HJEDIT 
100=C0NNECT,KEYBRD,DISPLY. 

110=ATTACH,AA , HCED I T, MR= 1 , I D  =CARTS  V . 

120=AA(KEYBRD, DISPLY , T1 , TAPE1 , INPUT, OUTPUT, TAPE6=OUTPUT) . 
130=R£TURN,K£YBRD,DISPLY,AA. 

140=*REWIND,  TAPE1  .OUTPUT. 

150a*E0R 

160=*E0F 


PROGRAM  HUEDIT  (TAPE1,  TAPE2,  TAPE3,  TAPE4,  INPUT,  OUTPUT) 

COMMON  /LOG/  IATP (4, 30) ,  IASP(4,41),  IUNIT(75,69) , 

Z  ITRUCKC560.7) ,  I7YPE(6,6),  IMIX(40,23),  INTER(9) , 

Z  IRSTMEC.20,3),  IATPSD(5) ,  IDAY,  TIME, 

$  ICSAC20),  LPPAR(S) ,  IASPAM(4,20) ,  LUOUT,  TCIST,  TCILNG,L00K(17) 
COMMON  /QUENUM/  IHEAD( 136) 

COMMON  /QUEPNT/  ITEMS (560) 

DATA  LOOK  /17*0/ 

READ(3)  IATP, IASP, IUNIT, ITRUCK, I TYPE, IMIX, 

Z  INTER, IRSTME, IATPSD , IDAY , TIME, ICSA , 

Z  LPPAR, IASPAM , LUOUT , TC I ST , TC I LNG , IHEAD , I TEMS 
10  WRITE (2, 7) 

7  FORMAT("  EDIT  DATA  FILE  ?  (YES/NO)  ") 

READ (1,17)  IANS 
17  FORMAT(AIO) 

IF(IANS.EQ."NO" .OR.IANS.EQ."N")  GO  TO  20 
CALL  EDIT 
GO  TO  10 

20  PRINT*," UPDATE  ARRAYS? 

READ21.IYN 

21  FORMAT (Al) 

IF(IYN.EQ."N")G0T030 
CALL  UPDATE 

G0T010 

30  WRITE(4)  IATP, IASP, IUNIT, ITRUCK, ITYPE, IMIX, 

Z  INTER, I RSTME , IATPSD, I  DAY , TIME , ICSA , LPPAR , IASPAM, LUOUT, 

Z  TCIST.TCILNG, IHEAD, ITEMS 
STOP 
END 
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SUBROUTINE  EDIT 

****  ALLOWS  EDITING  OF  DATA  IN  COMMON!  LOG 
****  H.  JONES  FEB  79 

****  NOTE  ALL  VARIABLES  IN  COMMON  LOG  ARE  2  DIMENSIONAL 
COMMON  /LOG/  IATP(4,30),  IASP(4,41),  IUNIT(75 ,69) , 

Z  ITRUCK (560,7),  ITYPE(6,6),  IMIX(40,23),  INTER(1,9), 

Z  IRSTME(20,3) ,  IATPSD(1,5) 

$  IDAY (1,1) ,  TIME (1,1) ,  ICSA(1,20) ,  LPPAR(1,5), 

Z  IASPAMC4.20),  LU0UT(1 ,1) ,  TCIST(l.l),  TCILNG(l.l) ,LOOK(1,17) 
COMMON  /QUENUM/  IHEAD(136) 

COMMON  /QUEPNT/  ITEMS(560) 

DIMENSION  INTGR(IO),  REAL(IO),  IWORD(IO) 

DIMENSION  NAME(19),  LIMIT1(19),  LIMIT1( 19) ,  LIMIT2(19) 

DATA  NAME  /"IATP",  "IASP",  "IUNIT",  "ITRUCK",  11 1  TYPE" , 

Z  "IMIX",  “INTER",  "IRSTME",  "IASPSD",  "IATPSD",  "IDAY", 

Z  "TIME",  " ICSA" ,  "LPPAR" ,  "IASPAM",  "LUOUT",  "TCIST", 

$  “ TCILNG" ,  "LOOK"/ 

DATA  LIMIT1  /4,"4,  75,  560,'  6, 

Z  40,  I,  20,  1,  1,  1, 

Z  1,  1,  1,  4,  1,  1,  1,  17/ 

DATA  LIMIT2  /30,  41,  69,  7,  6, 

Z  23,  9,  3,  5,  5,  1, 

Z  1,  20,  5,  20,  1,  1,  1,  1/ 

DATA  IEND/"END7 
NNAMES  *  19 
10  WRITE(2,100) 

LU1  -  1 

CALL  READF  (LU1,  10,  INTGR,  REAL,  IWORD) 

****  BRANCH  ON  OATA  TYPE 
15  IF(IW0RD(1)  .EQ.  I  END)  GO  TO  95 
DO  20  KTYPE  =  1, NNAMES 
I F( IWORD (1)  .EQ.  NAME(KTYPE))  GO  TO  3Q 
20  CONTINUE 
GO  TO  10 

****  SET  LIMITS  FOR  DATA  TYPE 
30  I LOW  =  INTGR(l) 

IHIGH  =  INTGR(2) 

IFLG  =  0 

IF (I LOW  .EQ.  0  .AND.  IHIGH  .EQ.  0)  IFLG  »  1 
I F ( IFLG  .EQ.  1)  I  LOW  =  1 
IF(IFLG  .EQ.  1)  IHIGH  =  LI8ITl(KTYPEl 
I F (IHIGH  .EQ.  0]  IHIGH  *  ILOW 
IFCIHIGH  .GT.  LIMIT1CKTYPED  IHIGH  =»  LlMITlQCTYPEl 
IF (I LOW  .GT.  LIMIT1CKTYPE))  GO  TO  10 
****  BACKGROUND  HAS  BEEN  SET,  READ  CHANGE  OR  LIST  COMMAND 
40  WRITE(2,120) 

CALL  READF  (LU1,  10,  INTGR,  REAL,  IWORD] 

I F (IWORD (1)  .EQ.  "LIST"  .OR.  IWORD (1)  .EQ.  "L"J  GO  TO  5Q 
I F ( I  WORD ( 1 )  .EQ.  "CHANGE"  .OR.  IW0RD(1]  .EQ;  "C"l  GO  TO  80 
GO  TO  15 

****  LIST  COMMAND 
50  IATT1  «  INTGR(l) 

IATT2  *  INTGR (2) 


IFLG  =  0 

IF (IATT1  .EQ.  0  .AND.  IATT2  .EQ.  0)  IFLG  =  1 
IF (IFLG  .EQ.  1)  IATT1  =1 
IF(IFLG  .EQ.  1)  IATT2  =  LIMIT2(KTYPE) 
IFCIATT2  .EQ.  0)  IATT2  =  IATT1 
IF(IATT2  .GT.  LIMIT2(KTYPE) )  IATT2  = 
IF(IATT1  .GT.  LIMIT2(KTVPE) )  GO  TO  40 
DO  70  INDEX  =  HOW,  IHIGH 
WRITE(2,140)  NAME (KTYPE),  INDEX 
DO  70  I  ATT  *  IATT1,  IAn2 
IF(KTYPE  .EQ.  1)  IVALUE  = 

IF (KTYPE  .EQ.  2)  IVALUE  = 

IF(K.TYPE  .EQ.  3)  IVALUE  = 

4)  IVALUE  3 

5)  IVALUE  » 

6}  IVALUE  = 


LIMIT2( KTYPE) 


•  EQ.  . 

•EQ.  7)  IVALUE 

•  EQ 


IFCKTYPE  .EQ 
IF (KTYPE  .EQ 
IFCKTYPE 
IF(KTYPE 
IFCKTYPE 

IFCKTYPE  .EQ _  _ 

IFCKTYPE  .EQ.  11}  IYALUE 
IFCKTYPE  .EQ.  12}  IVALUE 
IF (KTYPE  .EQ.  13)  IVALUE 
IF (KTYPE  .EQ.  14)  IVALUE 
IF(KTYPE  .EQ.  15)  IVALUE 
IF (KTYPE  .EQ.  16)  IVALUE 
IFCKTYPE  .EQ.  17)  IVALUE 
IFCKTYPE  .EQ. 

IF(KTYPE  .EQ. 

IF (KTYPE  .NE 


IATP(  INDEX,  I  An) 
IASP (INDEX,  IATT) 
IUNIT(INDEX,  IATT) 
ITRUCK(INDEX,  IATT) 
ITYPE( INDEX,  IATT) 
IMEX(INDEX,  IATT) 
INTERCINDEX,  IATT) 

8)  IRSTME  (INDEX,  IATT) 

IQ)  IVALUE  *  TATPSD (INDEX,  IATT) 
IDAY (INDEX,  IATT) 
TI0E(INDEX,  IATT) 
ICSA(INDEX,  IATT) 
LPPAR( INDEX,  IATT) 
IASPAM( INDEX,  IATT) 
LUOUT( INDEX,  IATT) 
TCI$T(INDEX,  IATT) 
TCILNG(INDEX,  IATT) 
LQOK(INDEX,  IATT) 


18)  IVALUE 

19)  IVALUE  = 
3)  GO  TO  60 

6  .AND.  IATT 
IVALUE 


.NE.  7)  GO  TO  60 


IF(IATT  .NE.  .  .... 

WRITE(2,160)  IATT, 

GO  TQ  70 
60  WRITE (2, 150)  IATT,  IVALUE 
70  CONTINUE 
GO  TO  40 
CHANGE  COMMAND 
8Q  IATT  *  INTGR(l) 

VALUE  *  INTGR(2)  +  REAL(l) 

IF(IATT  .GT.  LIMIT2(KTYPE))  GO  TO  40 
DO  90  INDEX  *  ILOW,  IHIGH 
INSERT  VALUE  IN  PROPER  ARRAY 
IFCKTYPE  .EQ.  1)  I ATP (INDEX,  IATT)  *  VALUE 
IF( KTYPE  .EQ.  2)  IASP(INDEX,  IATT)  »  VALUE 
IF (KTYPE  .EQ.  3)  IUNIT(INDEX,  IATT)  »  VALUE 
IF(KTYPE.EQ.3.AN0. ( IATT.EQ.6.0RIATT.EQ.7) ) 

Z  IUNIT(INDEX,IATT)*IW0RD(2) 

IF (KTYPE  .EQ.  4)  ITRUCK(INDEX,  IATT)  -  VALUE 
IFCKTYPE  .EQ.  5)  ITYPE(INDEX,  IATT)  -  VALUE 
IFCKTYPE  .EQ.  6  IMIX(INDEX,  IATT)  *  VALUE 
IFCKTYPE  .EQ.  7)  INTER(INDEX,  IATT)  -  VALUE 
IF  (KTYPE  .EQ.  8)  IR$TME(  INDEX,  IATT)  =■  VALUE 
IF (KTYPE  .EQ.  10}  IATPSO (INDEX,  IATT)  -  VALUE 
IFCKTYPE  .EQ.  11)  IDAY (INDEX,  IATT)  *  VALUE 
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IF( KTYPE  .EQ.  12)  TIME(INDEX,  IATT)  =  VALUE 
IF(KTYP£  .EQ.  13)  ICSA( INDEX,  IATT)  =  VALUE 
I F( KTYPE  .EQ.  14)  LPPAfi(INDEX,  IATT)  =  VALUE 
IF (KTYPE  .EQ.  15)  IASPAM(INOEX,  IATT)  =  VALUE 
IF(KTYPE  .EQ.  16)  LUOUT(INDEX,  IATT)  =  VALUE 
TF(KTYPE  .EQ.  17)  TCIST(INOEX,  IATT)  *  VALUE 
IF  (KTYPE  .EQ.  18)  TCILNG(INDEX,  I  An)  =  VALUE 
90  CONTINUE 
GO  TO  40 
95  RETURN 

100  F0RMAT(1X, "VARIABLE  NAME  =  "} 

120  F0RMAT(1X," 

140  F0RMAT(/,1X,A10,I5) 

150  FORMATCIX, "ATTRIBUTE  “,t4,"  3  \I7I 
160  F0RMAT(1X," ATTRIBUTE  ",14,"  =  “ ,A1QI 
END  ’  - 
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='-  SUBROUTINE  READF  (LU,  NUM,  INTGR,  REAL,  IWORD) 
****  RETURNS  UP  TO  NUM  INTEGERS,  REALS,  AND  STRINGS. 
****  BUNKS  AND  COMMAS  ARE  DELIMITERS 


****  H.  JONES  1979 

DIMENSION  INTGR(l) ,  REAL(l) ,  IWORDCl) 

DIMENSION  ICHR(82),  IALDI G( IQ.) 

DATA  IBUNK  /"  "/>  IPERD  /" ICOMMA  IMINUS 

DATA  IQUOT/1H"/ 

DATA  IALDI G  /"l"  ,"2"  ,"3"  ,"4"  ,"5"  ,"6”  ,"7"  ,"8"  ,"9“  "O"/ 
ICHR(ai)  =  IBUNK 
ICHRC82)  *  IQUOT 

READ  RECORD,  ZERO  OUT  OLD  INTGR,  REAL,  IWORD 
READ  (LU  ,1001  CICHRCI),  1*1,30] 

IF  (.EOF  (LU)  .NE.  Q)  GO  TO  60 
OD  4  1-2, NUM 
INTGR(I)*0 
REAL  (I )  =0 . 

4  IWORD CU  *  IBUNK 
KWORD-Q. 

KINTGR-Q 


KREAL=0 

N=Q 


****  CHECK  NEXT  CHARACTER  IN  RECORD 
****  SKIPPING  BLANKS  ********** 


10  MINUS  *  1 

11  N-N+l 

IF(N.EQ.81)  GO  TO  60 
IF(ICHR(N) .EQ.IBLANK)  GO  TO  11 
****  DETERMINE  IF  CHAR  IS  NUMBER  OR  ALPHA 
IF(ICHR(N)  ,EQ.  IQUOT)  GO  TO  41 
I F ( I C HR ( N )  .NE.  IMINUS)  GO  TO  12 
MINUS  =>  -1 
GO  TO  11 

12  I  START  -  N 
NUMB=0 

IFCICHR(N),.EQ.  IPERD)  GO  TO  28 
DO  25  1*1,10 

IF (ICHR(N) .EQ . IALDI  G(2 1 )  GO  TO  20 
15  CONTINUE 
GO  TO  40 

****  BUILDING  INTEGER  OR  INTEGER  PART  OF  REAL 
20  N-N+l 

IF(ICHR(N)  .NE.  IBUNK  .AND.  ICHR(N)  .NE.  IPERD 
Z  .AND.  ICHR(N)  .NE.  ICOMMA  )  GO  TO  20 
****  CALCUUTE  VALUE  OF  INTEGER 
I END  *  N-l 
NUMB-0 

DO  25  I- 1  START, I END 
DO  24  J-1,9 

IF (ICHR( I )  .EQ.  IALDIG(J))  GO  TO  25 
24  CONTINUE 


0-0 

25  NUMB  -  NUMB  +  J  *  10  **(IEND-I) 
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IF ( ICHR(N)  .EQ.  IPERO)  GO  TO  28 
****  NUMBER  WAS  INTEGER,  STORE  IT,  CHECK  FOR  BLANKS 
KINTGR  3  KINTGR  +1 
INTGR(KINTGR)  3  NUMB  *  MINUS 
GO  TO  10 

****  NUMBER  WAS  INTEGER  PART  OF  REAL,  NOW  BUILD  DECIMAL. 

28  RNUMB  *  FLOAT (NUMB) 

ISTART  3  N+l 

IFCICHRCISTART)  .EQ.  IBLANK)  GO  TO  39 
30  N3N+1 

IF(ICHR(N).NE. IBLANK  .AND.  ICHR(N) .NE.ICCMMA  )  GO  TO  30 
****  CALCULATE  VALUE  OF  DECIMAL 
IEND  3  N-l 
IDECPL  3  1 
NUMB-O 

DO  38  I3ISTART,IEND 
DO  34  >1,9 

IF(ICHR(r)  .EQ.  IALDIG(J})  GO  TO  35 

34  CONTINUE 

>0 

35  NUMB.  3  NUMB.  +  J  *  10**CtEND-Il 

38  IDECPL  3  IDECPL  *10 
****  ADD  INTEGER  AND  DECIMAL 

DECML3FL0AT(NUM8)/FL0ATCIDECPL] 

RNUMB  3  RNUMB  +  DECML 

39  KREAL  3  KREAL  +  1 
REALCKREALl  3  RNUMB  *  MINUS 
GO  TO  IQ 

****  BUILDING  STRING  ALPHANUMERIC 

40  N=N+1 

IFCICHRCNI.NE. IBLANK  .AND.  ICHRCN]  .NE.ICO0MA  )  GO  TO  40 
GO  TO  44 

41  ISTART  =  N+l 

42  N3N+1 

IFCICHRCN)  .NE.  IQUOT)  GO  TO  42 
44  IEND  3  N-l 

KWORD  3  KWORD  +  1 

LENSTR  3  IEND  -  ISTART  +  1 

IFCLENSTR  .GT.  IQ)  LENSTR  3  10 

ENCODE  (LENSTR,  90,  IWORD(.KWORD) )  CICHRCKKK),  KKK3 1  START,  IEND) 
GO  TO  10 
60  RETURN ■ 

90  FORMAT(lOAl) 

100  FORMAT (80A1) 

END 
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d.  SUBROUTINE:  UPDATE 

PURPOSE:  Allows  faster  update  of  data  arrays  in  COMMON  LOG. 

COMMON  BLOCKS:  LOG,  QUENUM,  QUEPNT 
CALLS:  None 
IS  CALLED  BY:  HUEDIT 
CALLING  PARAMETERS:  None 

LOCAL  ARRAYS:  INTGR(IO)— Storage  for  up  to  10  real  number  fields 

input  from  the  console. 

REAL  (10)— Storage  for  up  to  10  real  number  fields  input  from  the 
console. 

IWORD  (10)— Storage  for  up  to  10  alpha  numeric  fields  input  from 
the  console. 

NAME  (19)— Storage  for  the  names  of  the  19  arrays  and  variables  in 
COMMON  LOG. 

LIMIT  (19)— Storage  for  the  upper  limit  on  the  first  index  of  the 
arrays  and  variables  in  COMMON  LOG. 

FUNCTIONS:  Displays  to  the  operator  a  message  requesting  input  as 
to  the  variable  name  In  COMMON  LOG  that  is  of  interest. 

Accepts  from  operator  the  message  as  to  which  variable. 

Displays  message  requesting  input  as  to  whether  a 
change  or  replacement  of  attribute  values  is  desired. 

Accepts  operators  response. 

Displays  message  requesting  variable  word  number, 
attribute  number,  and  new  value  or  change  (— value/+ 
value) . 

An  input  of  0,  0,  0  exists  the  logic. 

An  input  of  "END"  exists  the  program. 
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SUBROUTINE  UPDATE 

ALLOWS  FASTER  UPDATE  OF  DATA  IN  COMMON/LOG/ 

G.  MARTIN  JULY  79 
COMMON  /LOG/  IATP(4,30),  IASP(4,41},  IUNIT(75 ,69) , 

7  ITYPE(S,6] ,  IMIX(40,23),  INTER(1,9), 

Z  IRSTME(20,3),  IATP$D(lf5J, 

$  IDAY(J,1(),  TIME  Cl  ,1} ,  ICSACl,20h  LPPAR(1,5) 

assjhil- TCIST(la)- 

COMMON  /QUEPNT/  ITEMS (560) 

DIMENSION  INTGR(IO) ,  REAL(IO) ,  IWORD(IO) 

DIMENSION  NAME(19),  LIMIT1(19),  LIMIT2(19) 

DATA  NAME  /"IATP",  "IASP",  "IUNIT",  "ITRUCK",  "I TYPE" 

Z  "IHIX",  "INTER" ,  "IRSTME" ,  "IASPSD",  "IATPSD"  "IDAY" 

Z  TIME",  "ICSA",  " LPPAR" ,  "IASPAM",  " LUODT" ,  "TCIST" 
$  "  TCI  LNG'V"  LOOK"/ 

DATA  LIMIT1  /4,  4,  75,  560,  6, 

Z  40,  1,  20,  1,  1,  1, 

Z  1,  1,  1,  4,  1,  1,  1,  17/ 

DATA  LIMIT2  /30,  41,  69,  7,  6, 

Z  23,  9,  3,  5,  5,  1, 

Z  1,  20,  5,  20,  1,  1,  1,  1/ 

DATA  IEND/"END"/ 

-100  PRINT*," VARIABLE  NAME  (OR  END)-  " 

READl.NRAY 

1  FORMAT CA6) 

I F  CNRAY . EQ . " END  ")GOTOlOOO 

DO  200  1=1,19 

INUM=I 

IF  CNRAY .EQ . NAME  Cl ) )G0T0210 
200  CONTINUE 
PRINT2.NRAY 

2  FORMAT("  VARIABLE  NAME  ",A6,"  NOT  VALID.") 

G0TQ100 

210  PRINT*, "CHANGE  OR  REPLACE?  " 

READ3.ICR 

3  F0RMATCA1) 

IF  CICR . EQ . " C" . OR . ICR . EQ . " R" ) G0T0300 

PRINT*, "ENTER  C  TO  CHANGE  (+  OR  -)  EXISTING  VALUES" 

•  PRINT*,"  R  TO  REPLACE  EXISTING  VALUES" 

G0T0210 


300  PRINT*, "ENTER  WORD#,ATTRI BUTE#, NEW  VALUE  (OR  CHANGE)" 
PRINT*," (0,0,0  WHEN  DONE)-  " 

310  READ*, IWD.IAT, VAL 
IF(IWD.EQ.0)G0T0100 

IF(IWD.LT.O.OR.IWD.GT.LIMITlClNUM) )G0T0320 
IF(IWD.GT.0.AND.IAT.LE.LIMIT2(INUM))G0T034O 
320  PRINT*, "WORD#  OR  ATTRIB.#  INVALID-ENTRY  IGNORED" 

330  PRINT*, "NEXT-  " 

G0T0310 

340  IF( ICR.EQ."C")GOT0350 

I F(I NUM  .EQ . 1 ) IATP( IWD , IAT) »IFIX(VAL) 

IF  Cl NUM . EQ .2)1 ASP ( IMO, I AT) »IF IX ( VAL) 


IF(INUM.EQ.3)IUNIT(IVID,  IAT)  =  IFIX(VAL) 

IF(INUH.EQ.4) ITRUCK(IWD, IAT)SIFIX(VAL) 
IF(rNUM.EQ.5)ITYPE(IWD, IAT) =IFIX(7AL) 
IF(INUH.EQ.6)IMIX(IWD,IAT}*IFIX(VAL) 
rF(INUM.EQ.7)INTERClW0,IAT)=IFIX(7AL) 
IF(INUM.Eq.8)IRS1M£(IWD,IAT)=IFIX(VAL) 
IF(INUM.EQ.10)IATPSD(rWD, IAT)=IFIX(7AL) 
rF(INUH.EQ .1I)IDAY (IWD, IAT)SIFIX(VAL) 

IF (INUM. EQ .12] TIME  ( IWD , I AT) =7AL 
IFCINUH-EQ  .13)rCSA(IWD,  IATKFIXCVAL) 
rFCrNU0.Eq.I4)LPPARClWD,IAT)=rFIXO?ALl 
IF(lNUM.Eq.l5)IASPAM(IWD,IAT)=*IFIXCyAL) 

IFCINUM  .Eq .16)LU0UT(IWD , IAT) =IFIX(VAL) 
IF(INUM.Eq.l7)TCIST(IWD,IAT)=VAL 
tF(INUH.Eq.l8)TCILN6(IWD,IAT)=7AL 
lF(INUM.Eq.l9)LOOK(IWO,IATHFIX(VAL) 

G0Tq330 

350  IF(INUM.Eq.l) IATP(IWD,IAT)aIATP(IWD, IAT)+IFIX(VAL) 
IF(INUM.Eq.2  IASP(rW0,IAT)=IASP{IWD,IAT)+IFIX(VAL) 
IFCINUM.Eq.3)IUNIT(IWDsIAT)=IUNIT(IWD,IAT)+IFIX(VAL) 
IFCINUM. Eq .4) ITRUCK(IWD, IAT)=ITRUCK(  IWD, IAT)+IFIX(VAL) 
IF(INUM.Eq.5)ITYPE(IWD,IAT)=ITYPE(IWD,IAT}-f-IFIX(7AL) 
IF(INUM.Eq.6)IMIX(IWD(IAT}»IMIX(IWD,IAT]+IPIX(7AL) 

I F( I NUM . Eq . 7 ) INTERCIWO, IATHNTERQ WD , IAT)+IFIX (7AL ) 

I F ( INUM . Eq . 8 } IRS7ME (I WD , IAT ] *>I  RSTME ( I WD , IATJ+I F I X (7A  L } 
IF(INUM.Eq.lO)IATPSD( IWO,IAT)aIATP$D(IWD, IAT)+I FIX(VAL) 
IF(.INUM.Eq.lI]  IDAYCIWD(IAT)=IDAY(IWD,IAT)+IFIX(VAL) 

I F  (i  NUM .  Eq .  12)  TIME-(  I  WD-,  I  AT) =TIME  ( I  WD ,  IAT )+ V  AL 
IFCINUM. Eq. 13) ICSA(IWD, IAT)*ICSA(IWD, IATJ+IFIXC  VAL) 
IF(INUM. EQ.  14  LPPAR(IWD,IATKPPAR(IWD,IAT)+IFIX(VAL) 
IF(INUM.Eq.l5)IASPAM(IWD,IAT)*IASPAM(IWD,IAT)+IFIX(VAL) 
IF(INUM.Eq.l6  LUOUT(IWD,IATKUOUT(IWD,IAT)+IFIX(VAL) 
IF(INUM.EQ.17  TCIST(IWD,IAT)=TCIST(IWD,IAT)+VAL 
I F (I NUM . Eq  .18 ) TC I LNG  CIWD , I AT ) *  TC I LNG  Cl  WD , I AT ) +VAL 
IFCINUM. Eq. 19lL00K(IWD, IAT)=LOOKClWD, IATJ+IFIXCVAL) 

GO  TO  330 
1000  RETURN 
END 
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e.  CALL  ROUTINE:  HJ DATABASE 

PURPOSE:  Called  to  obtain  a  print  out  of  the  existing  data  base. 

ATTACHES:  HCDATABASE 

IS  CALLED  BY:  Operator 

FUNCTIONS:  Operator  must  first  attach  as  TAPE  1  the  existing  data 
base  he  wants  to  print  out.  Then  the  operator  calls 
HJDATABASE,  ID3  .  This  call  routine  connects 

the  keyboard  and  display,  attaches  HCDATABASE  and  runs 
the  program.  When  finished  all  auxiliary  files  are 
returned  and  the  output  tape  rewound. 

HJDATABASE 

CONNECT,  KEYBRD,  DISPLY. 

ATTACH,  CC,  HCDATABASE,  ID-CARTSV. 

CC(TAPE  1,  KEYBRD,  DISPLY,  INPUT,  OUTPUT,  TAPE  6=0UTPUT) 

RETURN,  CC,  KEYBRD,  DISPLY,  TAPE  1. 

REWIND,  OUTPUT 

♦EOR 

♦EOF 

f.  CALL  ROUTINE:  HCDATABASE  (Binary  File  at  Program  DATA) 

PURPOSE:  To  print  data  contained  In  data  file. 

COWON  BLOCKS:  LOG,  QUENUM,  QUEPNT 

CALLS :  None 

IS  CALLED  BY:  HJDATABASE 

LOCAL  ARRAYS:  None 

FUNCTIONS:  Displays  to  the  operator  a  message  requesting  input 
as  to  files  to  be  printed. 


Accomplishes  printing  of  f 11  e/files  to  output  as 
requested  by  operator. 


PROGRAM  DATA  (TAPE1 ,TAPE2 ,TAPE3, INPUT, OUTPUT, TAP E6=OUTPUT) 

COMMON  /LOG/  IATP(4,30) ,1ASP(4,41) ,IUNIT(75,69) ,ITRUCK(560 ,7 ) , 

Z  ITYPE(6,6) ,IMIX(40,23) ,INTER{9) ,IRSTME(20,3) ,IATPSD(5) , 

Z  IDAY,TIME, ICSA(20) ,LPPAR(5) ,IASPAM(4,20) ,LUOUT,TCIST, 

Z  TCILNG, LOOK( 17) 

COMMON  /QUENUM/  IHEAD(136) 

COMMON  /QUEPNT/  ITEMS(560) 

DATA  LOOK.  /17*0/ 

READ(l)  IATP, IASP, IUNIT, ITRUCK, I TYPE, IMIX, INTER, IRSTME, IATPSD, IDAY 
Z, TIME, ICSA, LPPAR, IASPAM, LUOUT, TCIST, TCILNG, IHEAD, I TEMS 
WRITEC6.110) 

HQ  FORMAT C10X," ARM  DATA  BASE”! 

IQ  WRITE(3,100) 

10Q  FORMAT C"  ARM  DATA  BASE  PRINT  OPTIONS  :",/, 

Z  "  (1)  -  PRINT  ALL",/, 

I  "  (2)  -  ATP",/, 

Z  "  (3)  -ASP",/, 

Z  "  (4)  -  UNIT',/, 

Z  "  (5)  -  TRUCK",/, 

Z  "  (6)  -  REMAINING",/, 

Z  "  (7)  -  STOP",/, 

Z  "  ?  " ) 

IF (IANS . LT . 1 . OR . IANS . GT. 7 )  GO  TO  10 
GO  TO  (30, 30, 40, 50, 60, 70,80), IANS 

C****  ATP 

30  WRITE (6, 120) 

120  FORMAT (/ / / , 26 X , " ******  ATP  DATA  ******" ,//,llX,"ATP  1",11X, 

Z  "ATP  2" ,11X,"ATP  3" ,11X ,"ATP  4",/) 

DO  20  1=1,30 

20  WRITE(6 ,130)  I ,(IATP( J,I) ,J=1 ,4) 

130  F0RMAT(3X,I2,5X,I6,3(10X,I6) ) 

IF(IANS.NE.l)  GO  TO  10 

C****  asp 

40  WRITE(6,140) 

140  F ORMA T (1K1 ,  26X ," ******  ASP  DATA  ******"  ,//,llX,"ASP  1",11X, 

Z  "ASP  2"  ,11X,"ASP  3"  ,11a, "ASP  4",/) 

DO  21  1=1,41 

21  WRITE(6 ,130)  I  ,(IASP(J,I), >1,4) 

IF(IANS.NE.l)  GO  TO  10 

C****  UNIT 

50  WRITE (6 ,160) 

160  FORMAT (1H 1,3 IX,  "******  UNIT  DATA  ******" ,// , IX, "UNIT’  ,6X , 

Z  "TYPE" ,6X, "ATP", 7X, "ASP", 6X,"ATP  DIST",7X,"ASP  DIST" ,8X,"UTM"  , 

Z  8X," JIFFY  NAME", 6X, "NO.  HELO" , 4X, "PULSE" ,/ ,11X, "AMMO" ,3X, 

Z  "WPNS  ALIVE", 3X,"WPNS  SHORT' ,3X ,"RNDS  SHORT" ,3X  ."CURRENT" , 

Z  4X,"RRL" ,5X ,"CRL" ,5X,"BAL" ,3X ,"TRK  AMMO", 3X, "Cl  SURV",3X, 

Z  "SHORT’ ,3X," TOT  RNDS" ) 

K»1 

L»7 

55  00  22  I*K,L 

IF (IUNIT( 1,1) ,EQ.O)  GO  TO  35 

WRI TE (6 , 170 )  I, ( I UNI T( I , J ) ,J=1,7) ,IUNIT(I ,68) ,IUNIT(I,69) 
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170  FORMAT (/ ,2X,I2,9X,I1,8X,I1 ,9X,I1,10X,I2 ,13X,I3 ,8X,A10,6X ,A10 , 

z  8x,n,9x,ii) 

WRITE(_S ,1801  CtUN  ITCl ,  J  L  J-8,67  ] 

180  F0RMAT(12X,I2,8X,I2,11X,I2,9X,I5,7X,I5,3X,I5,3X,I5,3X,I5,2X, 

Z  r7,8X,r2,6X,I2,4X,I7) 

35  IF(I.EQ.75)  GO  TO  57 

22  CONTINUE 
K=L+1 
L=L+7 

WRITE  (6, 160) 

GO  TO  35 

57  IFdANS.NE.il  GO  TO  IQ 
C****  TRUCK 

60  WRITE [6 490] 

120  f0RBATQRl,29X, ********  TRUCK  DATA  ******",//, IX, "TRUCK" ,5X, 

Z  " TYP E" , 4X , 1 " M I SS I ON" ,4X, "STATUS, 4X," OWNER" ,6X,"MIX",6X, 

Z  "%  LOAD", 5X," LAST  FAIL") 

K=1 

L-56 

65  DO  23  I=K,L 

WRITEC6,2QQ]  r,CtTRDCKCl,J],0=l,7l 
200  F0RMAT(2X,I3,8X,I1,8X,I1,10X,I1,7X,I3,8X,I2,7X,I3,9X,I4) 
IFCl.EQ.560)  GO  TO  67 

23  CONTINUE 
K=iL+l 


L-L+56 

WRITE(6 ,190) 
GO  TO  65 


67  IF(IANS.NE.l)  GO  TO  10 
C****  MIX 

70  WRITE (6 ,210) 

210  FORMAT (1H1 , 41X , " ******  AMMO  DATA  ******",//, IX, "MIX" ,3X,"1" , 
Z  3X,"2" ,3X,"3" ,3X,"4" ,3X,"5" ,3X,"6" ,3X,"7" ,3X,"8"  ,3X,"9",3X, 


Z  " 10" ,3X ," 11" , 3X ," 12" , 3X ,"13" ,3X , " 14"  ,3X ," 15" , 3X , " 16"  ,3X ,"  17" 
Z  3X,"  18"  , 3X , "  19"  , 3X , " 20"  ,3X , " 21"  ,3X , " 22"  , 3X , " 2 3"  ,/ ) 

DO  24  1*1,40 

WRITE (6,220)  I ,(IMIX(I,J), J-1,23) 

220  F0R8AT(2X,I2,23(1X,I4)} 

24  CONTINUE 


I 


C***"  ATPSD 

WRITE(6 ,230)  (lATPSD(I)  ,1-1,5) 

230  FORMAT(/ ,5X ,"***+**  ATp  SERVICE  DATA  ******",// ,5(3X ,12)) 

C****  DAY,TCIST,TCILNG,TIMD,LUOUT 

WRITE (6, 240)  IDAY.TCIST.TCILNG.TIME.LUOUT 
240  F ORMAT (// , 5X , " ******  MISC  DATA  ******" ,//,5X,"IDAY  =  "  ,11, 5X, 

Z  "TCIST  *  " ,F7. 2,5X,"TCILNG  *  "  ,57.2, 5X," TIME  =  \F7.2,5X, 

Z  "LUOUT  *  ",I2] 

C"***  ASPAM 

WRITE (6, 250) 

250  FORMAT (1H1.26X, "******  ASP  AMMO  REMOVED  ******",// ,11X ,' "ASP  1", 
Z  UX,"ASP  2"  ,11X,"ASP  3"  ,11X,"ASP  4",/) 

DO  25  1-1,20 

25  WRITE(6,260)  I ,( IASPAM( J,I ) , J-l ,4) 
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260  F0RMAT(3X,I2,5X,I6,3(10X, 16) ) 


C****  RSTME 


WRITE (6,270) 

270  F0RMATC//,10X, "******  RESUPPLY  TIME  DATA  ******",// ,10X  " SETUP" 
Z  10X," LOAD/ 100"  ,10X,' "TRAVEL" ,/) 

DO  26  1=1,20 

26  WRITE (6 ,280)  I , ( I RSTME ( I , J) , J-1,3) 

280  F0RMAT(4X,I2,4X,13X,I4 ,13X,I4) 

C****  TYPE 


WRITE(6 ,290} 

290  F0RMAT(// ,7X, "******  TRUCK  SPEEDS,  MTBF,  AND  MTTR  ******"  // 
Z  3X," TRUCK", 3X," 2D  NT",3X,"2D  DAY",2X,"HI  NT",3X,"HI  DAY"  3X 
Z  "MTBF" ,5X,"MTTR" ,/) 

DO  27  1=1,6 

27  WRITE C6,300)  I, (ITYPE(I, J) , J=l,6 
300  F0RMAT(5X,I2,4(5X,I3) ,2(5X,I4) ) 

C****  INTER 


» 


WRITE(6,310)  ( I NTER ( I ), 1=1,9) 

^310  F0RMAT(1H1,20X, "******  INTERDICTION  DATA  ******",// ,9(5X, 13) ) 
C**  AA  CSA 


WRITE(6 ,320) 

320  FORMATC//  ,5X," ******  AMMO  FROM  CSA  ******", //,9X," AMMO"  ,11X 
Z  "AMP') 

DO  28  1=1,20 

28  WRITE(6,330)  I,ICSA(I) 

330  F0RMAT(10X,I2,10X, 15) 

C****  lppar 

WRITE(6,340)  (LPPAR(I) ,1=1,5) 

340  FORMAT(//, 7X,"*******  LPPAR  ******", //,5X,I2,2(5X, II) ,5X, 13 
Z  5X,I2,///1 
IF(IANS.NE.l)  GO  TO  10 
80  WRITE(6,350) 

350  F0RMAT(1X," END  OF  DATA") 

STOP 

END 


* 


* 
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g.  PROGRAM:  HSREADJIF 

PURPOSE:  To  read  Jiffy  produce  demand  files  that  is  provided  as 
input  to  ARM. 

COMMON  SLOCKS:  None 

CALLS :  None 

IS  CALLED  BY:  HJREADJIF 

CALLING  PARAMETERS:  None 

LOCAL  ARRAYS:  None 

FUNCTIONS:  Read  Jiffy  produced  binary  file. 

Provides  a  means  of  looking  at  input  generated 
by  the  attrition  model. 
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PROGRAM  CH£CK(INPUT,0UTPUT5TAPIN,TAPE5»INPUT,TAPE6=QUTPUT,TAPE2=TA 

Z  PIN) 

DIMENSION  I NFI LE ( 64 ) 

1  READ ( 2 ) INFILE 
IF (EOF ( 2 ) ) 100,2 

2  WRITE (.6, 200)  (INFILE(I)  ,1*1,26} 

200  FORMAT(/ , 1X,A10,2X,5F8.3,/ ,(13X,5F8.3) ) 

GO  TO  1 
100  STOP 
END 

*EOR 

*E0F 
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h.  PROGRAM:  HSRDJIFCH 


PURPOSE:  To  enable  the  operator  to  change  the  ammunition 
expenditure  data  generated  by  Jiffy. 

COMMON  BLOCKS:  None 

CALLS:  INPUT,  OUTPUT 

IS  CALLED  BY:  Operator 

CALLING  PARAMETERS:  None 

LOCAL  ARRAYS:  FILE  (64)— storage  for  up  to  64  words  read  from  the 

Jiffy  produced  binary  file. 

FUNCTIONS:  Displays  a  message  to  the  operator  requesting  to  know 
what  changes  are  to  be  made,  single  field,  all  of  one 
ammunition  type,  or  all  ammunition  of  all  records. 

Accepts  from  operator  desired  response  and  displays 
subsequent  to  appropriate  message. 

Allows  operator  to  change  the  various  ammunition 
expenditures  obtained  from  Jiffy  by  multiplying 
expenditures  by  a  decimal  factor. 
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anooM  -e*  a  o  o  ho  o  ooo<~> 


PROGRAM  CHANG ( I NPUT , OUTPUT , TAP I N ,  TA POUT, T APE 1 aTAP I N , TAPE 2=TAPQUT 
*, TAPE6=0UTPUT, TAPE21 ) 


CAN  READ, DISPLAY  AND  CHANGE  BINARY  INPUT  FILE  TO  ARM. 

DIMENSION  FILEC64) 

SET  FOR  INTERACTIVE  USE. 

CALL  C0NNEC(5LINPUT) 

CALL  C0NNEC(60UTPUT) 

Nl=  1 
N2=  2 

PRINT*,"  IF  CHANGE  IS  TO  SINGLE  FIELD  IN  1  RECORD . ENTER  1" 

PRINT*,1'  IF  CHANGE  IS  TO  ALL  OF  1  AMMO . ENTER  2" 

PRINT*,"  IF  CHANGE  IS  TO  ALL  AMMO  OF  ALL  RECORDS . ENTER  3" 

PRINT*," 

I AMMO  =  0 
READ*,  IFLG 

IF(IFLG.LT.1.0R.IFLG.GT. 3)  GO  TO  1 
IF( IFLG.NE.2)  GO  TO  3 
INPUT  AMMO  TYPE 

2  PRINT*,"  AMMUNITION  TO  BE  CHANGED." 

PRINT*,"  " 

READ*,  I  AMMO 

IF(IAMMO .LT.1.0R. IAMM0.GT.25)  GO  TO  2 

3  IF(IFLG.EQ.l)  GO  TO  4 
INPUT  AMMO  CHANGE  FACTOR 

PRINT  *,"  ENTER  FACTOR  (DECIMAL  (1.5))  TO  MULTIPLY  BY." 
PRINT*,"  " 

READ  *  FA f TOR 
READ  RECORDS  ADD  CHANGE. 

READ(Nl)  FILE 
IF(EOF(Nl) )  50,5 
5  IF(IFLG.GT.l)  GO  TO  7 
WRITE (6 ,100)  (FILE CD,  1-1,261 
)0  F0RMAT(/1X ,A10,2X,5F8. 1 ,/, ( 13X.5F8. 1) ) 

NOW  MUST  DECIDE  IF  WANT  TO  CHANGE  A  FIELD  IN  THIS  RECORD. 

PRINT  *,"  DO  YOU  WISH  TO  CHANGE  A  FIELD  IN  " 

PRINT  *,"  THIS  RECORD  (Y  OR  N)." 

PRINT*,"  " 

READ200.WISH 
200  FORMAT (Al) 

IF(WISH.EQ."N")  GO  TO  10 

PRINT  *,  "  ENTER  FIELD  NUMBER  C2  -  26)." 

PRINT*,"  " 

READ  *, IFLD 

PRINT  *,"  ENTER  NEW  VALUE." 

PRINT*,"  " 

READ  *, VALUE 
FILE(IFLD)  -  VALUE 
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GO  TO  6 

C  CHANGE  RECORD. 

7  DO  8  1=1,5 
INO  *  5  *  (1-1)  *  3 
IF(IAMMO.NE.FILE(IND) )  GO  TO  8 
FILE(IND+3)  =  FIL£(IND+3)  *  FACTOR 
8  CONTINUE 

C  WRITE  OUT  RECORD. 

10  WRITE(N2)  FILE 
GO  TO  4 

50  PRINT*,"  CHANGE  ANOTHER  AMMO  ?  (Y  OR  N)." 
PRINT*,  "  " 

READ  300, IANS 
300  FORMAT  CA1) 

IF(IANS.EQ."N" )  GO  TO  60 

REWIND  1 

REWIND  2 

Nl=  3  -  N1 

N2=  3  -  N2 

GO  TO  2 

60  PRINT*,  "  GOOD  OUTPUT  ON  TAPE  21" 

REWIND  N2 
DO  99  1=1,999 
READ(N2)  FILE 
IF(E0F(N2) )  999,88 
88  WRITE(21)  FTLE 
99  CONTINUE 
999  CONTINUE 
REWIND  21 
STOP 
END 

*EOR 

*EOF 

*EOR 

*EOF 


i.  PROGRAM:  TRKQUE 

PURPOSE:  To  enable  the  operator  to  put  the  trucks  in  their 
respective  queues  as  part  of  the  initial  data  base  development. 

COWiON  8L0CKS:  LOG,  QIJENUM,  QUEPNT 

CALLS:  TRKPUT  PRINT 

IS  CALLED  BY:  HJTRKQUE 

CALLING  PARAMETERS:  None 

LOCAL  ARRAYS:  None 

FUNCTIONS:  Displays  a  message  to  the  operator  requesting  to  know 
if  modification  of  truck  queues  is  desired. 

If  a  positive  response  is  made  it  calls  subroutine 
TTCKPUT  which  allows  modification  of  the  truck  queues. 

If  a  negative  response  is  made  it  asks  if  a  printout  of 
queue  contents  is  desired. 


PROGRAM  TRKQUE(TAPE1,TAPE2,TAPE3,TAPE4, INPUT, OUTPUT, TAPE 6=OUTPUT) 
COMMON  /LOG/  IATP(4,30) , IASP{4 ,41) ,IUNIT(75,69) , ITRUCK( 560 ,7) , 

Z  ITY PE ( 6,6) ,IMIX(25,17) , INTER(9) ,IRSTME( 14,3) , IATPSD(5) , 

Z  IDAY.TIME, ICSA(14) ,LPPAR( 5) , IASP4M(4,14) ,LUOUT,TCIST, 

Z  TCILNG, L00K(17) 

COMMON  /OUENUM/  IHEAD( 136) 

CCMMON  /QUEPNT/  ITEMS(560) 

DATA  LOOK  /17*0/ 

READ( 1 )  I ATP, IASP, IUNIT, ITRUCK, I TYPE, IMIX, INTER, IRSTME, IATPSD, IDAY 
Z, TIME, ICSA,LPPAR,IASPAM,LUOUT,TCIST, TCILNG, IHEAD, ITEMS 
10  WRITE(3,100) 

100  FORMAT ("  MODIFY  TRUCK  QUEUES?  (YES/NO)  ") 

READ(2,110)  IANS 

110  FORMAT(AIO) 

IFCIANS  .EQ.,,NO"  .OR.  IANS.EQ."N" )  GO  TO  40 
CALL  TRKPUT 
40  WRITE.(3 ,120) 

120  FORMAT C"  PRINT  OUT  CONTENTS  OF  QUEUES?  (Y ES/NO]  ''} 

READ(2,110)  IANS 

IF(IANS.EQ."NO" .0R.IANS.EQ."N")  GO  TO  50 
CALL  PRINT 
GO  TO  10 

50  WRITE(4)  IATP, IASP, IUNIT, ITRUCK, ITYPE, IMIX, INTER, IRSTME, 

Z  IATPSD , I  DAY , TIME , I CSA, LPPAR, IAS  PAM, LUOUT, TCIST, TCI LNG, 

Z  IHEAD, ITEMS 
STOP 
END 


SUBROUTINE  TRKPUT 

C****  ALLOWS  INTERACTIVE  TRUCK  QUEUE  RE-ASSIGWENT 
C****  H.  JONES  FEB  79 

DIMENSION  INTGR(IO) ,  REAL(IO) ,  IWORD(IO) 

C 

WRITE(2,10) 

10  F0RMAT( IX," COMMAND  EXAMPLES  :"  ,/, 

Z  1X,"GET  3  FROM  35  ",/, 

Z  IX, "PUT  3,  10  IN  105  ",/, 

Z  IX, "LIST  105  ",/, 

Z  IX, "TAKE  ALL  OUT  ",/, 

Z  IX, "END  ",/) 

C 

15  WRI TE  ( 2 , 20 ) 

20  FORMAT("  ...  ") 

CALL  READF  (2,  10,  INTGR,  REAL,  IWORD) 

IF(IW0RD(1)  .EQ.  "END"  .OR.  IWORD(l)  .EQ.  "E")  GO  TO  50 
IF (IWORD(I)  .EQ.  "PUT"  .OR.  IWORD(l)  .EQ.  "P")  GO  TO  30 
IF(IW0RD(1)  .EQ.  "LISr  .OR.  IWORD(l)  .EQ.  "L")  GO  TO  40 
IFf IWORD  1  .EQ.  "GET"  .OR.  IWORD(l)  .EQ.  "G")  GO  TO  25 
IFCIWORD(l)  .EQ.  "TAKE"  .OR.  IWORD(l)  .EQ.  "T")  GO  TO  60 
GO  TO  15 
C 


175 


4 


c****  get  truck  from  queue  without  re-ordering  queue 

25  II  *  INTGR(l) 

12  »  INTGR(2) 

IF(INTGR(3)  .NE.  0)  GO  TO  15 
I FLAG  =  0 

CALL  NXTQUE  (IFIRST,  12) 

26  CALL  NXTQUE (NTRK,  12) 

IF(NTRK.EQ.O)  GO  TO  15 

IF(NTRK  .EQ.  IFIRST  .AND.  IFLAG  .NE.  0)  GO  TO  15 
CALL  GETQUE(NTRK,  12) 

IF ( I 1  .EQ.  IFIRST)  GO  TO  15 

IF(I1  .NE.  NTRK)  CALL  PUTQUE  (NTRK,  12) 

IFLAG  *  1 
GO  TO  26 
C 

C****  PUT  TRUCK  IN  QUEUE 
30  1.1  *  INTGR(l) 

12  =  INTGR(2) 

13  =  INTGR(3) 

IF CINTGRC.3)  .EQ.  0)  13  *  INTGR(2) 
rFClNTGR(3)  .EQ.  0)  12  *  INTGR(l) 

DO  35  1*11,12 
35  CALL  PUTQUE  (I,  13) 

GO  TO  15 
C 

C****  LIST  TRUCKS  IN  QUEUE 

40  CALL  NXTQUE  (IFIRST,  INTGR(l) ) 

IF(IFIRST  .EQ.  0)  GO  TO  15 
42  CALL  GETQUE(NTRK,  INTGR(l) ) 

CALL  PUTQUE (NTRK,  INTGR(l) ) 

WRITE(2,45)  NTRK 
45  F0RMAT(1X ,15) 

CALL  NXTQUE  (I NEXT,  INTGR(l)) 

IF(INEXT  .NE.  IFIRST)  GO  TO  42 
GO  TO  15 
C 

C****  TAKE  ALL  TRUCKS  OUT  OF  QUEUES 
60  CALL  SETQUE  (560,  136) 

GO  TO  15 
C 

50  RETURN 
END 
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SUBROUTINE  REAOF  (LU,  NUM,  INTGR,  REAL,  IWORD) 

C****  RETURNS  UP  TO  NUM  INTEGERS,  REALS,  AND  STRINGS. 

C****  BLANKS  AND  COMMAS  ARE  DELIMITERS 
C****  H.  JONES  1979 

DIMENSION  INTGR(l) ,  REAL(l) ,  IWORD(l) 

DIMENSION  ICHRC82],  lALDIG(lO) 

DATA  IBLANK  /"  "/,  IPERD  ICORMA  IMINUS 

DATA  IQUOT/IH‘7 

DATA  IALDIG  /"l"  ,"2"  ,"  3"  ,"4"  ,"5"  ,"6"  ,,,7"  ,''8"  ,"9"  ,"0'7 
ICHR(81)  =  IBLANK 
ICHR(82)  =  IQUOT 
C 

C****  READ  RECORD,  ZERO  OUT  OLD  INTGR,  REAL,  IWORD 
READ(LU, 100)  ( ICHR(I) ,  1=1,80) 

I F( EOF ( LU )  .NE.  0)  GO  TO  60 
DO  4  1  =  1, NUM 
I NTGR( I ) =0 
REAL(I )=0. 

4  I WORD (I)  =  IBLANK 
KW0RD=0 
KINTGR=0 
KREAL=0 
N=0 
C 

C****  CHECK  NEXT  CHARACTER  IN  RECORD 
C****  SKIPPING  BLANKS  ********** 

10  MINUS  =  1 

11  N=N+1 

IF(N.EQ. 81)  GO  TO  60 
IF(ICHR(N).EQ. IBLANK)  GO  TO  11 
C 

C****  DETERMINE  IF  CHAR  IS  NUMBER  OR  ALPHA 
IF(ICHR(N)  .EQ.  IQUOT)  GO  TO  41 
IF(ICHR(N)  .NE.  IMINUS)  GO  TO  12 
MINUS  =  -1 
GO  TO  11 

12  ISTART  =  N 
NUMB*0 

IF(ICHR(N).EQ. IPERD)  GO  TO  28 
DO  15  1*1,10 

IF(ICHR(N) .EQ.IALDIG(I) )  GO  TO  20 
15  CONTINUE 
GO  TO  40 
C 

C****  BUILDING  INTEGER  OR  INTEGER  PART  OF  REAL 
20  N»N+1 

IF ( I CHR( N)  .NE.  IBLANK  .AND.  ICHR(N)  .NE.  IPERD 
Z  .AND.  ICHR(N)  .NE.  ICOMMA  )  GO  TO  20 
C 

c****  CALCULATE  VALUE  OF  INTEGER 
TEND  *  N-l 
NUM8-0 

DO  25  I = ISTART, IEND 
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DO  24  J-1,9 

IF (ICHR( I )  .EQ.  IALDIG(J))  GO  TO  25 

24  CONTINUE 
J=0 

25  NUMB  »  NUMB  +  J  *  10  **(IEND-I) 

IF { I CHR (N)  .EQ.  IPERD)  GO  TO  28 

C 

C****  NUMBER  WAS  INTEGER,  STORE  IT,  CHECK  FOR  BLANKS 
KINTGR  =  KINTGR  +1 
INTGR(KINTGR)  =  NUMB  *  MINUS 
GO  TO  10 
C 

C****  NUMBER  WAS  INTEGER  PART  OF  REAL,  NOW  BUILD  DECIMAL 
28  RNUMB  *  FLOAT (NUMB) 

I  START  *  N+l 

IF (ICHR(ISTART)  .EQ.  I  BLANK)  GO  TO  39 
30  N=N+1 

IF ( ICHR( N) .NE. IBLANK  .AND.  ICHR(N).NE.ICCMMA  )  GO  TO  30 
C 

C****  CALCULATE  VALUE  OF  DECIMAL 
IEND  *  N-l 
IDECPL  =■  1 
NUMB=0 

DO  38  I-ISTART.IEND 
DO  34  J-1,9 

IF(.ICHR(I)  .EQ.  IALDIG(J))  GO  TO  35 

34  CONTINUE 
J=0 

35  NUMB  =  NUMB  +  J  *  10**(IEN0-I) 

38  IDECPL  »  IDECPL  *  10 
C 

C****  ADD  INTEGER  AND  DECIMAL 

DECML*FLOAT(NUMB)/FLOAT(.IDECPL) 

RNUMB  *  RNUMB  +  OECML 

39  KREAL  »  KREAL  +  1 
REAL(KREAL)  »  RNUMB  *  MINUS 
GO  TO  10 

C 

C****  BUILDING  STRING  ALPHANUMERIC 

40  N-N+l 

IF(ICHR(N).NE. IBLANK  .AND.  ICHR(N) .NE.ICQMMA  )  GO  TO  40 
GO  TO  44 

41  ISTART  *  N+l 

42  N-N+l 

IFCICHR(N)  .NE.  IQUOT)  GO  TO  42 
44  IEND  *  N-l. 

KWORO  -  KWORD  +  1 

LENSTR  *  IEND  -  ISTART  +  1 

IF(LENSTR  .GT.  10)  LENSTR  «  10 

ENCOOE(LENSTR,  90,  IWORD(KWORD))  (ICHR(KKK) ,  KKK-ISTART,  IEND) 

^  ft  TA  1  ft  ’ 


60  RETURN 
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90  FORMAT ( 10A1 ) 
100  F0RMAT(80A1) 
END 


SUBROUTINE  NXTQUE  (ITEM,  NUMQUE) 

C****  SHOWS  NEXT  ITEM  IN  QUEUE  (LEAVES  IT  IN) 
C****  H.  JONES  FEB  79 

COMMON  /QUENUM/  NHEAD( 136) 

COMMON  /QUEPNT/  IPNT(560) 

ITEM  *  0 
LITEM  =  0 

I POINT  *  NHEAD(NUMQUE) 

C 

10  IFCIPOINT  .EQ.  0)  GO  TO  20 
LITEM  =  ITEM 
ITEM  =  I  POINT 
I POINT  =  IPNT(ITEM) 

GO  TO  10 
C 

20  RETURN 
END 


SUBROUTINE  PUTQUE  (ITEM,  NUMQUE) 
C****  PUTS  ITEM  IN  QUEUE  NUMQUE 
C****  H.  JONES  DEC  78 

COMMON  /QUENUM/  NHEAD( 136 ) 

COMMON  /QUEPNT/  IPNT(560) 

IOLDH  =  NHEAD( NUMQUE) 
NHEADCNUMQUE)  -  ITEM 
IPNT(ITEM)  =  IOLDH 
RETURN 
END 


SUBROUTINE  GETQUE  (ITEM,  NUMQUE) 

C****  GETS  ITEM  FR0M  qUEUE  NUMqUE 

C****  TO  GET  TRUCK  FROM  QUEUE  4  -  CALL  GETQUE  (N,4) 

C****  H.  JONES  DEC  78 

COMMON  /QUENUM/  NHEAD(136) 

COMMON  /QUEPNT/  IPNT(56Q) 

ITEM  «  0 
LITEM  *  0 

I POINT  *  NHEAD( NUMQUE) 

C 

10  IF (I POI NT  .EQ.  0)  GO  TO  20 
LITEM  =  ITEM 
ITEM  -  I POINT 
I POI NT  •  IPNT(ITEM) 

GO  TO  10 

20  IF (LITEM  .GT.  0)  IPNT(LITEM)  »  0 
IF (LITEM  .EQ.  0)  NHEAO(NUMQUE)  -  0 


c 


RETURN 

END 


SUBROUTINE  SETQUE  (ITEMS,  NUMQUE ) 
C****  SETS  UP  NUMQUE  EMPTY  QUEUES  FOR  ITEMS. 
C**+*  H .  JONES  DEC  78 

COMMON  /QUENUM/  NHEAD(136) 

COMMON  /QUEPNT/  IPNT(560) 

00  10  1*1, NUMQUE 
10  NHEAD(I)  =  0 
DO  20  I *1, ITEMS 
20  IPNT(I)  *  0 
RETURN 
END 


SUBROUTINE  PRINT 

C****  PRINTS  OUT  THE  CONTENTS  OF  EVERY  TRUCK  QUEUE 
C****  D.  HILLIS  APR  79 

COMMON  /QUENUM/  NHEAD (136) 

COMMON  /QUEPNT/  IPNT(560) 

DIMENSION  NTRKC251 
DO  100  T-1,136 
CALL  NXTQUE(IFIRST.I) 

IF(IFIRST.EQ.O)  GO  TO  50 
DO  90  J-1,25 

.  CALL  GETOUE(NTRK(J) ,1 ) 

CALL  pUTQUE(NTRK(J),I) 

CALL  NXTQUE(INEXT.I) 

IF(INEXT.EQ.IFIRST)  GO  TO  40 
90  CONTINUE 
40  WRITE(6,200)  I 

200  F0RMAT(/,5X, “QUEUE  ",13,"  TRUCKS") 

WRITE(6 ,210)  (NTRK(K) ,K=1,J) 

210  F0RMAT(10(1X,I3) ) 

GO  TO  100 
50  WRITE (6 ,200)  I 
WRITE(6 ,220) 

220  FORMAT (5X," NONE") 

100  CONTINUE 
RETURN 
END 
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